Populate Excel sheet with file name and table result from word file
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Populate Excel sheet with file name and table result from word file
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?
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?
-
- Administrator
- Posts: 78534
- 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
Yes, that is possible.
Do the documents contain only one table, or could there be more?
Do the documents contain only one table, or could there be more?
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Populate Excel sheet with file name and table result from word file
The documents will only ever have have one table.
-
- Administrator
- Posts: 78534
- 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
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
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Populate Excel sheet with file name and table result from word file
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.
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
-
- Administrator
- Posts: 78534
- 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
Excellent!
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Populate Excel sheet with file name and table result from word file
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.
The table cells that have a Content Control are truncating the last letter of the text to copy over.
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)
-
- Administrator
- Posts: 78534
- 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
Try changing that line to
unless that has unwanted side effects.
Code: Select all
objWS.Cells(r, c + 1).Value = Replace(Replace(strText, Chr(7), ""), vbCr, vbLf)
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Populate Excel sheet with file name and table result from word file
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.
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)
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
Set doc = Documents.Open(Filename:=strPath & strFile, AddToRecentFiles:=False)
You do not have the required permissions to view the files attached to this post.
-
- Administrator
- Posts: 78534
- 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
Are you running the code from Word or from Excel?
Best wishes,
Hans
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
-
- Administrator
- Posts: 78534
- 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
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:
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
Hans
-
- 3StarLounger
- Posts: 254
- Joined: 09 May 2020, 14:00
Re: Populate Excel sheet with file name and table result from word file
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.
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.