Macro to copy table from Word into Excel based on table headers

Lexcel18

New Member
Joined
May 25, 2018
Messages
3
Hello, I would like to create a macro that when copies a table (with a specific heafer) from a Word file into an Excel worksheet.
The top row (header) of the table I need is always the same in all files and I think this will be a good way to to identify the table. An alternative option would be to copy the last table from the word file. I found some related info here which I am planning to "play" with to create this macro: https://www.mrexcel.com/forum/excel-questions/36875-word-table-into-excel-worksheet.html .
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
For what you've described you could use code like:
Code:
Sub GetWordTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, i As Long
Dim WkBk As Workbook, WkSht As Worksheet
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkBk = ThisWorkbook
With wdApp
  'Hide the Word session
  .Visible = False
  'Disable Alerts
  .DisplayAlerts = wdAlertsNone
  'Disable Auto Macros in the documents being processed
  .WordBasic.DisableAutoMacros
  'Loop through all documents in the folder
  strFile = Dir(strFolder & "\*.doc", vbNormal)
  While strFile <> ""
    'Open the document
    Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, _
      ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      If .Tables.Count > 0 Then
        'Create an output sheet for the document
        Set WkSht = WkBk.Sheets.Add
        WkSht.Name = Split(strFile, ".doc")(0)
        'Process the last table in the document
        With .Tables(.Tables.Count).Range
          For i = 1 To .Cells.Count
            With .Cells(i)
              WkSht.Cells(.RowIndex, .ColumnIndex) = Split(.Range.Text, vbCr)(0)
            End With
          Next
        End With
      End If
    .Close SaveChanges:=False
    End With
    strFile = Dir()
  Wend
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing: Set WkBk = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function
The above code extracts data from the last table in each Word document in the selected folder. Do note that there is a limitation in writing Word table data to Excel, in that separate paragraphs in a Word cell would be written to separate Excel cells; the above code simply extracts the first paragraph from each cell.
 
Upvote 0
Thank you. I will try out the code in a few days when I will have access to a PC. (I'm posting from my smartphone.) As far as I remember there is only one paragraph in each cell of the tables I need, so the code should fit my needs pretty nicely.
 
Upvote 0
This is a great Macro. Does anyone know how to modify it so that the tables are posted into one tab rather than creating new tabs for each file?
 
Upvote 0

Forum statistics

Threads
1,224,271
Messages
6,177,619
Members
452,786
Latest member
k3calloway

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top