VBA是否将word文档中的表格中的文本复制到excel？

我有一个word文档：

Table 1

A      A
B      B

Table 2

C      C
D      D

我试图将word文档中表格中的每一段文本复制到excel中的单元格中，如下所示：

卓越：

Column A      Column B
A             A
B             B
C             C
D             D

Column A     Column B
C            C
D            D

下面的代码只是复制word文档中的最后一个表。产生这个结果：

卓越：

Column A      Column B
A             A
B             B
C             C
D             D

Column A     Column B
C            C
D            D

这是我的密码：

Sub ImportWordTable()
Dim objWord As Object
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel

Set objWord = GetObject(, "Word.Application")

Set wdDoc = objWord.ActiveDocument

With wdDoc
TableNo = wdDoc.tables.Count
    If .tables.Count > 0 Then
    With .tables(TableNo)
        'copy cell contents from Word table cells to Excel cells
        For iRow = 1 To .Rows.Count
            For iCol = 1 To .Columns.Count
                Cells(iRow, iCol) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
            Next iCol
        Next iRow
    End With
    End If
End With

Set wdDoc = Nothing

End Sub

有人能告诉我哪里出了问题吗？ 我想我需要为TableNo的每个循环添加一个

差不多

For Each TableNo In wdDoc
Next TableNo

---

您仅在一个表中的单元格中循环，而您还需要在文档的每个表中循环

你可以试试这样的

Sub ImportWordTable()
Dim objWord As Object
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim i As Long
Dim r As Long, c As Long
Set objWord = GetObject(, "Word.Application")

Set wdDoc = objWord.ActiveDocument
r = 1
c = 1
With wdDoc
TableNo = wdDoc.tables.Count
    If .tables.Count > 0 Then
        For i = 1 To TableNo
            With .tables(i)
                'copy cell contents from Word table cells to Excel cells
                For iRow = 1 To .Rows.Count
                    For iCol = 1 To .Columns.Count
                        Cells(r, c) = WorksheetFunction.Clean(.cell(iRow, iCol).Range.Text)
                        c = c + 1
                    Next iCol
                    c = 1
                    r = r + 1
                Next iRow
            End With
            c = 1
        Next i
    End If
End With
Set wdDoc = Nothing
End Sub