導入Word文檔數據到Excel（多個文檔）

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 
'.........