使用 excel 宏 VBA 将第一个 table 从 word 文档复制到 excel

Question

我是 Excel 宏和 VBA 的新手。

我需要使用宏 VBA.

将 table 数据从 word 文档复制到 excel sheet

我需要在特定文件夹中的多个版本文档中执行文档V1.2 版本。例如：我有文档 "C:\Test\FirstDocV1.1.doc" & "C:\Test\FirstDocV1.2.doc"。

我只想执行 "C:\Test\FirstDocV1.2.doc" 并获取 table 数据。无论如何我都试过了，但它说的是 "No tables".

查看我的代码如下。

Sub importTableDataWord()
    Dim WdApp As Object, wddoc As Object
    Dim strDocName As String

    On Error Resume Next
    Set WdApp = GetObject(, "Word Application")

    If Err.Number = 429 Then
       Err.Clear
        Set WdApp = CreateObject("Word Application")
    End If

    WdApp.Visible = True
    strDocName = "C:\Test\FirstDocV1.2.doc"

'I am manually giving for version 1.2 doc. But I need to select which contains v1.2 version automatically from Test folder.    
    If Dir(strDocName) = "" Then
        MsgBox "The file is not present" & strDocName & vbCrLf & " or was not found"
        Exit Sub
    End If

    WdApp.Activate
    Set wddoc = WdApp.Documents(strDocName)

    If wddoc Is Nothing Then Set wddoc = WdApp.Documents.Open(strDocName)
        wddoc.Activate
        Dim Tble As Integer
        Dim rowWd As Long
        Dim colWd As Long
        Dim x As Long, y As Long

        x = 1
        y = 1

        With wddoc
            Tble = wddoc.tables.Count
            If Tble = 0 Then
                MsgBox "No Tables Found in the document"
                Exit Sub
            End If

            For i = 1 To Tble
                With .tables(i)
                    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
            Next
        End With

    wddoc.Close savechanges:=False
    WdApp.Quit

    Set wddoc = Nothing
    Set WdApp = Nothing
End Sub

谁能帮帮我。

Answer 1

您没有看到代码存在许多问题，因为错误处理对您来说不是很好。我已经在下面更正了它们。 On Error Resume Next 不是很有启发性，因为当发生错误时，代码只是保持运行向前。您希望通过在编写例程时捕捉其中的大部分来纠正这些错误。

在我进行编辑之前，我做了一些你应该养成习惯的事情：

添加了 Option Explict（这将使您更难在代码中引入错误，因为它需要明确的语法。这是一门很好的学科，我怎么鼓励都不为过）
已编译。（在编写代码时定期执行此操作。它将帮助您解决问题）
声明了变量i。这在我使用 Option Explicit 编译时被标记（没有在您的代码中创建问题，但如果您不使用显式变量很容易引入错误）

然后我改为使用特定对象引用

设置对 Word 库的引用（这使调试方式更容易，因为您将在编辑器中使用智能感知并可以使用 [F2] 浏览 Word 库）
将通用对象引用更新为Word.Application和Word.Document

然后我修正了错误。

首先，我将错误处理更改为使用 On Error GoTo，然后我解决了在处理代码时发生的每个错误。

wdApp.Activate 导致错误
wdDoc 从未真正被创建，所以它是 Nothing

在我更正这些之后，我添加了一行以获取名称中包含 "V1.2.doc" 的文档。

最后，我删除了循环，因此只有第一个 Table 被复制为所要求的问题。

Option Explicit

Public Sub ImportTableDataWord()
    Const FOLDER_PATH As String = "C:\Test\"

    Dim sFile As String

    'use the * wildcard to select the first file ending with "V1.2.doc" 
    sFile = Dir(FOLDER_PATH & "*V1.2.doc")

    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

使用 excel 宏 VBA 将第一个 table 从 word 文档复制到 excel

Copy first table from word document to an excel using excel macro VBA

excel

vba

ms-word