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

时间:2018-07-10 09:12:00

标签: excel vba excel-vba copy-paste excel-2016

我正在尝试将表从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

1 个答案:

答案 0 :(得分:0)

问题是sFile = Dir(FOLDER_PATH & " *.docx ")无法获得正确的docx文件。

这是可见的,如果您在调用子程序之前写了MsgBox FOLDER_PATH & sFile