vba - 使用 VBA 将 Word 表复制到 Excel 时出错

Question

我正在尝试将表格从 Microsoft Word 2016 复制到 Microsoft Excel 2016，但不是很成功。

我收到一个错误

User-defined type not defined

在下面的这部分代码中：

Public Sub ImportTableDataWordDoc(ByVal strDocName As String)  

请问有人可以帮我吗？

整个代码如下：

Option Explicit

Public Sub ImportTableDataWord()
Const FOLDER_PATH As String = " \User\kritikata\Desktop\Articulateexporteddata\"

Dim sFile As String

sFile = Dir(FOLDER_PATH & " *.docx ")

If sFile = " " Then
    MsgBox " The file is not present or was not found "
    Exit Sub
End If

ImportTableDataWordDoc FOLDER_PATH & sFile
End Sub


Public Sub ImportTableDataWordDoc(ByVal strDocName As String)

Dim WdApp As Word.Application
Dim wddoc As Word.Document
Dim nCount As Integer
Dim rowWd As Long
Dim colWd As Long
Dim x As Long
Dim y As Long
Dim i As Long

On Error GoTo EH

If strDocName = "" Then
    MsgBox "The file is not present or was not found"
    GoTo FINISH
End If

Set WdApp = New Word.Application
WdApp.Visible = False

Set wddoc = WdApp.Documents.Open(strDocName)

If wddoc Is Nothing Then
    MsgBox "No document object"
    GoTo FINISH
End If

x = 1
y = 1

With wddoc

    If .Tables.Count = 0 Then
        MsgBox "No Tables Found in the document"
        GoTo FINISH
    Else

        With .Tables(1)
            For rowWd = 1 To .Rows.Count
                For colWd = 1 To .Columns.Count
                    Cells(x, y) = WorksheetFunction.Clean(.Cell(rowWd, colWd).Range.Text)
                    y = y + 1
                Next 'colWd
                y = 1
                x = x + 1
            Next 'rowWd
        End With

    End If

End With

GoTo FINISH
EH:

With Err
    MsgBox "Number" & vbTab & .Number & vbCrLf _
        & "Source" & vbTab & .Source & vbCrLf _
        & .Description
End With

'for debugging purposes
Debug.Assert 0
GoTo FINISH
Resume
FINISH:

On Error Resume Next
'release resources

If Not wddoc Is Nothing Then
    wddoc.Close savechanges:=False
    Set wddoc = Nothing
End If

If Not WdApp Is Nothing Then
    WdApp.Quit savechanges:=False
    Set WdApp = Nothing
End If
End Sub

标签： vbaexcelcopy-pasteexcel-2016

Answer 1

问题是sFile = Dir(FOLDER_PATH & " *.docx ")没有得到正确的 docx 文件。

这是可见的，如果您MsgBox FOLDER_PATH & sFile在调用 sub 之前编写。