Macro for filling in invoices with excel and word

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