Question

所有

如何修改下面的代码，不仅要获取特定文件夹中每个word文档的第一个表，还要从每个文档中提取所有表格？我自己试过操纵代码，但我似乎无法正确操作。任何帮助将不胜感激。

Option Explicit

Sub test()

Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oCell As Word.Cell
Dim sPath As String
Dim sFile As String
Dim r As Long
Dim c As Long
Dim Cnt As Long

Application.ScreenUpdating = False

Set oWord = CreateObject("Word.Application")

sPath = "C:\Users\Domenic\Desktop\" 'change the path accordingly

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

sFile = Dir(sPath & "*.doc")

r = 2 'starting row
c = 1 'starting column
Cnt = 0
Do While Len(sFile) > 0
Cnt = Cnt + 1
Set oDoc = oWord.Documents.Open(sPath & sFile)
For Each oCell In oDoc.Tables(1).Range.Cells
    Cells(r, c).Value = Replace(oCell.Range.Text, Chr(13) & Chr(7), "")
    c = c + 1
Next oCell
oDoc.Close savechanges:=False
r = r + 1
c = 1
sFile = Dir
Loop

Application.ScreenUpdating = True

If Cnt = 0 Then
   MsgBox "No Word documents were found...", vbExclamation
End If

End Sub

Answer 1

Dim tbl

'........
Set oDoc = oWord.Documents.Open(sPath & sFile)
For each tbl in oDoc.Tables
    For Each oCell In tbl.Range.Cells
        Cells(r, c).Value = Replace(oCell.Range.Text, Chr(13) & Chr(7), "")
        c = c + 1
    Next oCell
    r = r + 2 'couple of blank rows between tables
    c = 1
Next tbl

oDoc.Close savechanges:=False
'.........

将Word文档数据导入Excel（多个文档）

1 个答案: