VBA Copy Tables from Word to Excel

[muhammad susanto]

Cross posted
http://www.eileenslounge.com/viewtopic.php?f=26&t=37822

---

hi all.

i found code from google but i don't how the code is worked well, i have testing but not work
i want the code can copy table from ms word into ms excel

Sub CopyTables()
    Dim oWord As Word.Application
    Dim WordNotOpen As Boolean
    Dim oDoc As Word.Document
    Dim oTbl As Word.Table
    Dim fd As Office.FileDialog
    Dim FilePath As String
    Dim wbk As Workbook
    Dim wsh As Worksheet

    ' Prompt for document
    Set fd = Application.FileDialog(msoFileDialogOpen)
    With fd
        .Filters.Clear
        .Filters.Add "Word Documents (*.docx)", "*.docx", 1
        .Title = "Choose a Word File"
        If .Show = True Then
            FilePath = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With

    On Error Resume Next

    Application.ScreenUpdating = False

    ' Create new workbook
    Set wbk = Workbooks.Add(Template:=xlWBATWorksheet)

    ' Get or start Word
    Set oWord = GetObject(Class:="Word.Application")
    If Err Then
        Set oWord = New Word.Application
        WordNotOpen = True
    End If

    On Error GoTo Err_Handler

    ' Open document
    Set oDoc = oWord.Documents.Open(Filename:=FilePath)
    ' Loop through the tables
    For Each oTbl In oDoc.Tables
        ' Create new sheet
        Set wsh = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
        ' Copy/paste the table
        oTbl.Range.Copy
        wsh.Paste
    Next oTbl

    ' Delete the first sheet
    Application.DisplayAlerts = False
    wbk.Worksheets(1).Delete
    Application.DisplayAlerts = True

Exit_Handler:
    On Error Resume Next
    oDoc.Close SaveChanges:=False
    If WordNotOpen Then
        oWord.Quit
    End If
    'Release object references
    Set oTbl = Nothing
    Set oDoc = Nothing
    Set oWord = Nothing
    Application.ScreenUpdating = True
    Exit Sub

Err_Handler:
    MsgBox "Word caused a problem. " & Err.Description, vbCritical, "Error: " & Err.Number
    Resume Exit_Handler
End Sub

this original link
https://answers.microsoft.com/en-us/...d-c9a981636d24

anyone help me out..greatly appreciated
.susanto