Populate Excel sheet with file name and table result from word file

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Populate Excel sheet with file name and table result from word file

Post by gailb »

Hello,

I have multiple Word documents in a folder and would like to extract information from a table into a Excel file. All the Word documents are designed exactly the same with one Table in the document.

The table is 2x3 and I would like to retrieve the data from row 2, columns 1, 2, and 3.

So basically, in the Excel file I would like to see 4 columns of data. Column A would have the file name without the extension, Column B thru Column D would hold the results from the table in order. The column headers could simply be, Hdr1 - Hdr4.

Can this do done?

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

Re: Populate Excel sheet with file name and table result from word file

Post by HansV »

Yes, that is possible.
Do the documents contain only one table, or could there be more?
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Populate Excel sheet with file name and table result from word file

Post by gailb »

The documents will only ever have have one table.

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

Re: Populate Excel sheet with file name and table result from word file

Post by HansV »

The following is air code, please test carefully and report any errors.

Code: Select all

Sub ProcessTables()
    Dim objXL As Object
    Dim objWB As Object
    Dim objWS As Object
    Dim f As Boolean
    Dim r As Long
    Dim c As Long
    Dim strPath As String
    Dim strFile As String
    Dim doc As Document
    Dim tbl As Table
    Dim strText As String
    
    ' Set up Excel worksheet
    On Error Resume Next
    Set objXL = GetObject(Class:="Excel.Application")
    If objXL Is Nothing Then
        Set objXL = CreateObject(Class:="Excel.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    Set objWB = objXL.Workbooks.Add(-4167)
    Set objWS = objWB.Worksheets(1)
    
    ' Folder path, must end in \
    strPath = "C:\MyDocs\"
    
    ' Loop through documents
    strFile = Dir(strPath & "*.doc*")
    Do While strFile <> ""
        ' Open document
        Set doc = Documents.Open(FileName:=strPath & strFile, AddToRecentFiles:=False)
        ' New row
        r = r + 1
        ' Filename in column A
        objWS.Cells(r, 1).Value = Left(strFile, InStrRev(strFile, ".") - 1)
        ' First table in document
        Set tbl = doc.Tables(1)
        ' Loop through row 2 of table
        For c = 1 To 3
            strText = tbl.Cell(2, c).Range.Text
            objWS.Cells(r, c + 1).Value = Replace(Left(strText, Len(strText) - 2), vbCr, vbLf)
        Next c
        ' Close document
        doc.Close SaveChanges:=False
        ' On to the next document
        strFile = Dir
    Loop
    
ExitHandler:
    On Error Resume Next
    Application.ScreenUpdating = True
    If f Then
        objXL.Visible = True
    End If
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Populate Excel sheet with file name and table result from word file

Post by gailb »

This works great Hans.

I just modified to use the activeworkbook instead of a new workbook and then modified the path to accept the current path.

Code: Select all

    Set objWS = ActiveWorkbook.Worksheets(1)
    
    ' Folder path, must end in \
    strPath = ActiveWorkbook.Path & Application.PathSeparator

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

Re: Populate Excel sheet with file name and table result from word file

Post by HansV »

Excellent!
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Populate Excel sheet with file name and table result from word file

Post by gailb »

Hi Hans,

A follow-up question. I'm expanding this to work with another project, but turning a few of the table cells into a Content Control does not copy over the info correctly.

Code: Select all

objWS.Cells(r, c + 1).Value = Replace(Left(strText, Len(strText) - 2), vbCr, vbLf)
The table cells that have a Content Control are truncating the last letter of the text to copy over.

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

Re: Populate Excel sheet with file name and table result from word file

Post by HansV »

Try changing that line to

Code: Select all

            objWS.Cells(r, c + 1).Value = Replace(Replace(strText, Chr(7), ""), vbCr, vbLf)
unless that has unwanted side effects.
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Populate Excel sheet with file name and table result from word file

Post by gailb »

Hi Hans,

Yes, that did enter in some unwanted side effects. It's adding a space at the end which is showing at a 10 using =Code(Right(B2))

Not knowing the right way to fix this, this does seem to work, but then I'm having trouble getting the sheet to autofit to the contents.

Code: Select all

    objWS.Range("A:O").Replace Chr(10), "", xlPart, , , , False, False
    objWS.Rows(1).Insert
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    ActiveSheet.UsedRange.EntireRow.AutoFit
Also, this code is working fine on my home computer, but when I transfer over to my work computer, I get the error below, and it debugs to...

Set doc = Documents.Open(Filename:=strPath & strFile, AddToRecentFiles:=False)
error.png
You do not have the required permissions to view the files attached to this post.

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

Re: Populate Excel sheet with file name and table result from word file

Post by HansV »

Are you running the code from Word or from Excel?
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Populate Excel sheet with file name and table result from word file

Post by gailb »

From Excel

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

Re: Populate Excel sheet with file name and table result from word file

Post by HansV »

The code was written to be run from Word, since you posted this in the Word forum.
It has to be modified to be run from Excel:

Code: Select all

Sub ProcessTables()
    Dim objWD As Object
    Dim objDoc As Object
    Dim objTbl As Object
    Dim f As Boolean
    Dim r As Long
    Dim c As Long
    Dim strPath As String
    Dim strFile As String
    Dim wsh As Worksheet
    Dim strText As String
    
    ' Set up Word
    On Error Resume Next
    Set objWD = GetObject(Class:="Word.Application")
    If objWD Is Nothing Then
        Set objWD = CreateObject(Class:="Word.Application")
        f = True
    End If
    On Error GoTo ErrHandler
    
    ' Use active sheet
    Set wsh = ActiveWorkbook.Worksheets(1)
    
    ' Folder path, must end in \
    strPath = ActiveWorkbook.Path & Application.PathSeparator
    
    ' Loop through documents
    strFile = Dir(strPath & "*.doc*")
    Do While strFile <> ""
        ' Open document
        Set objDoc = objWD.Documents.Open(Filename:=strPath & strFile, AddToRecentFiles:=False)
        ' New row
        r = r + 1
        ' Filename in column A
        wsh.Cells(r, 1).Value = Left(strFile, InStrRev(strFile, ".") - 1)
        ' First table in document
        Set objTbl = objDoc.Tables(1)
        ' Loop through row 2 of table
        For c = 1 To 3
            strText = objTbl.Cell(2, c).Range.Text
            strText = Replace(Replace(strText, Chr(7), ""), vbCr, "")
            wsh.Cells(r, c + 1).Value = strText
        Next c
        ' Close document
        objDoc.Close SaveChanges:=False
        ' On to the next document
        strFile = Dir
    Loop
    
    ' Clean up
    wsh.Rows(1).Insert
    wsh.UsedRange.EntireColumn.AutoFit
    
ExitHandler:
    On Error Resume Next
    Application.ScreenUpdating = True
    If f Then
        objWD.Quit SaveChanges:=False
    End If
    Exit Sub
    
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub
Best wishes,
Hans

gailb
3StarLounger
Posts: 254
Joined: 09 May 2020, 14:00

Re: Populate Excel sheet with file name and table result from word file

Post by gailb »

Hi Hans,

That update worked well; however, on the Word side, it asked me to enable macros. It only did it once, but then after selecting enable it run all the way thru.