Importing Word Document Data into Excel (Multiple Documents)

Question

All,

How can I modify the code below to not just grab the first table of each word document in a specific folder but to extract all of the tables from each document? I've tried manipulating the code myself but I can't seem to get it right. Any help would be greatly appreciated.

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