Copy Word Tables to Excel

jonsnow
NewLounger
Posts: 2
Joined: 13 Oct 2021, 17:47

Copy Word Tables to Excel

Post by jonsnow »

I'm looking to use VBA to copy tables from a word document (there are about
80 pages in the word document, with 1 table per page) and I want to copy
them to a new sheet in a new workbook. I've seen some code on this
site, but I'm unclear how to do the "loop." The word document will be
located in a specific directory and I want to save
the new excel document with the same name as the word document back to that
same directory. Is it better to start with both the word and excel
documents open or is it better to have the VBA open and close them? Please let me
know the best way to proceed. Any and all help would/is appreciated.

Thank you

User avatar
HansV
Administrator
Posts: 72196
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy Word Tables to Excel

Post by HansV »

Welcome to Eileen's Lounge!

I'll work on it. Stay tuned.
Regards,
Hans

User avatar
HansV
Administrator
Posts: 72196
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Copy Word Tables to Excel

Post by HansV »

The following macro is intended to be run from Word. Make sure that the document with the tables is the active document.
I'm not sure about saving to OneDrive, I have no experience with that, so I hope it'll work.

Code: Select all

Sub CopyTables()
    Dim xlApp As Object
    Dim xlWbk As Object
    Dim xlWsh As Object
    Dim f As Boolean
    Dim doc As Document
    Dim tbl As Table
    Dim sFile As String
    On Error Resume Next
    ' Try to get running instance of Excel
    Set xlApp = GetObject(Class:="Excel.Application")
    If xlApp Is Nothing Then
        ' If that failed, start Excel
        Set xlApp = CreateObject(Class:="Excel.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    ' Create a workbook with one sheet
    Set xlWbk = xlApp.Workbooks.Add(Template:=-4167) ' xlWBATWorksheet
    ' Refer to the active document
    Set doc = ActiveDocument
    ' Loop through the tables in the document
    For Each tbl In doc.Tables
        ' Copy the table
        tbl.Range.Copy
        ' Create a new sheet after the existing sheet(s)
        Set xlWsh = xlWbk.Worksheets.Add(After:=xlWbk.Worksheets(xlWbk.Worksheets.Count))
        ' Paste the table
        xlWsh.PasteSpecial Format:="HTML", NoHTMLFormatting:=True ' or False
    Next tbl
    ' Delete the (empty) first sheet
    xlApp.DisplayAlerts = False
    xlWbk.Worksheets(1).Delete
    xlApp.DisplayAlerts = True
    ' Save the new workbook
    sFile = doc.FullName
    sFile = Left(sFile, InStrRev(sFile, ".")) & "xlsx"
    xlWbk.SaveAs FileName:=sFile, FileFormat:=51 ' xlOpenXMLWorkbook
ExitHandler:
    On Error Resume Next
    ' Try to close the workbook
    xlWbk.Close SaveChanges:=False
    ' If we started Excel, close it
    If f Then
        xlApp.Quit
    End If
    Exit Sub
ErrHandler:
    ' Report error message
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Regards,
Hans

jonsnow
NewLounger
Posts: 2
Joined: 13 Oct 2021, 17:47

Re: Copy Word Tables to Excel

Post by jonsnow »

Thank you