VBA Automated extraction of tables from word file and table processing

Hey everyone,

I'm a beginner with VBC and a bit stuck on coding the following complicated problem. Here is what I would like to do:
- I have a list of .rtf files in a folder (see example file: Attachment 29647). These files contain multiple tables with patient medication. Each table has a header which is one paragraph/line above the table. The headers are not formatted as such, but as plain test.
- I'd like to extract all tables from all documents in my folder and place them in an excel sheet.
- I'd then like to add two new columns to the left of each table (one column labelled with name_document, one column labelled with header_table).
- Into each cell of the name_document column, I'd like to add the name of the document I extracted the table from.
- Into each cell of the header_table column, I'd like to add the name of the table, as defined by the header one paragraph/line above the table.

I found the following code to extract tables from a list of documents.

Code:

---

Sub ExtractTablesFromMultiDocs()
  Dim objTable As Table
  Dim objDoc As Document, objNewDoc As Document
  Dim objRange As Range
  Dim strFile As String, strFolder As String
'  Initialization
  strFolder = InputBox("Enter folder address here: ")
  strFile = Dir(strFolder & "" & "*.rtf", vbNormal)
Set objNewDoc = Documents.Add
'  Process each file in the folder.
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & "" & strFile)
    Set objDoc = ActiveDocument
For Each objTable In objDoc.Tables
      objTable.Range.Select
      Selection.Copy
Set objRange = objNewDoc.Range
      objRange.Collapse Direction:=wdCollapseEnd
      objRange.PasteSpecial DataType:=wdPasteRTF
      objRange.Collapse Direction:=wdCollapseEnd
      objRange.Text = vbCr
    Next objTable
objDoc.Save
    objDoc.Close
    strFile = Dir()
  Wend
End Sub

---

Any suggestions how to amend it for my purpose? Help is much appreciated!!!

Best,
Thomas

The following Excel macro should do as you want:

Code:

---

Sub GetTableData()
'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, wdTbl As Word.Table
Dim strFolder As String, strFile As String, WkBk As Workbook, WkSht As Worksheet
Dim StrTbl As String, r As Long, i As Long, j As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
Set WkBk = ActiveWorkbook
'Disable any auto macros in the documents being processed
wdApp.WordBasic.DisableAutoMacros
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  Set WkSht = WkBk.Sheets.Add: r = 1
  WkSht.Name = Split(strFile, ".doc")(0)
  With wdDoc
    For Each wdTbl In .Tables
      With wdTbl.Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "[^13^l]"
        .Replacement.Text = "¶"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
      End With
      If r > 1 Then r = r + 2: i = r
      wdTbl.Range.Copy
      WkSht.Paste Destination:=WkSht.Range("C" & r)
      StrTbl = wdTbl.Range.Paragraphs.First.Previous.Range.Text
      r = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
      For j = i To r
        WkSht.Range("A" & r).Value = Split(strFile, ".")(0)
        WkSht.Range("B" & r).Value = StrTbl
      Next
    Next
    WkSht.UsedRange.Replace What:="¶", Replacement:=Chr(10), LookAt:=xlPart, SearchOrder:=xlByRows
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
ErrExit:
wdApp.Quit
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

---

Simply select the folder to process. The macro creates a new worksheet for each document and outputs all tables from that document one below the other, with an empty row in between. Except for text wrapping, table formatting is preserved as much as possible.

If you don't want a new worksheet for each document, delete:

Code:

---

  Set WkSht = WkBk.Sheets.Add: r = 1
  WkSht.Name = Split(strFile, ".doc")(0)

---

change:

Code:

---

Set WkBk = ActiveWorkbook

---

to:

Code:

---

Set WkBk = ActiveWorkbook: Set WkSht = WkBk.ActiveSheet

---

and change:

Code:

---

Dim StrTbl As String, r As Long, i As Long, j As Long

---

to:

Code:

---

Dim StrTbl As String, r As Long, i As Long, j As Long: r = 1

---

Paul, nice use of the character class ([^13^l]) in the .Find function to replace all LineFeeds and FormFeeds with a paragraph mark (pilcrow -
¶).... which you later replace in the Excel range with a Carriage Return (char(10)). Do LineFeeds and FormFeeds both mark the end of a table?

I also like your use of the command concatenation operator ( : ) to string together similar commands on one line as in:

Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing: Set WkBk = Nothing

And lastly, the GetFolder() function is the cats-meow of efficiency.

I do have a question about your use of the BinaryCompare argument to the Split() function. Why not the TextCompare argument?

Nicely done, as is all the VBA code of yours that I have viewed in my short time on VBA Express. Thanks for contributing so generously
to those of us toiling in the VBA arena. :clap:

Dave

Hi Dave,
that's great! Thanks a lot for your help on this!

Cheers,
Thomas

Quote:

---

Originally Posted by DaveM

Paul, nice use of the character class ([^13^l]) in the .Find function to replace all LineFeeds and FormFeeds with a paragraph mark (pilcrow -
¶).... which you later replace in the Excel range with a Carriage Return (char(10)). Do LineFeeds and FormFeeds both mark the end of a table?

---

This process concerns Word table cells that contain paragraph breaks and/or line breaks. If those are not removed before copying the table to Excel, the output goes to separate rows in Excel. The subsequent replacement of the pilcrow in Excel is to restore those formats as line breaks within the cells concerned.

Word table cell and row ends are designated by the Chr(13) and Chr(7) pair, which appear as '¤'symbols.

Quote:

---

Originally Posted by DaveM

I do have a question about your use of the BinaryCompare argument to the Split() function. Why not the TextCompare argument?

---

Since Word files are ordinarily saved with lower-case extensions (.doc, .docx, .docm), I saw no need to add the the TextCompare argument.

Quote:

---

Originally Posted by macropod

Word table cell and row ends are designated by the Chr(13) and Chr(7) pair, which appear as '¤'symbols.

---

Da-ding! Your code indicated LineFeed and Formfeed chars, but your reply indicated a Linefeed and Bell character. Is that right.... that a Chr(7) is part of the end-of-row character pair? (I hope I'm not muddying the water here).

Quote:

---

Originally Posted by DaveM

Da-ding! Your code indicated LineFeed and Formfeed chars, but your reply indicated a Linefeed and Bell character.

---

As I said,

Quote:

---

This process concerns Word table cells that contain paragraph breaks and/or line breaks. If those are not removed before copying the table to Excel, the output goes to separate rows in Excel.

---

The F/R removes paragraph breaks and manual line breaks that might occur within a cell - it has nothing to do with Word's end-of-cell or end-of-row markers.

Quote:

---

Originally Posted by DaveM

but your reply indicated a Linefeed and Bell character. Is that right.... that a Chr(7) is part of the end-of-row character pair?

---

That is correct.

OK, Paul, so I think I'm square with your code:

..... use of the character class ([^13^l]) in the .Find function to replace all LineFeeds (^13) and FormFeeds/Page Breaks (^L) with a paragraph mark (pilcrow -
¶)

Separate from that F/R, you indicate that the end-of-row in a table is a pair of characters (Chr(13)+Chr(7)), represented by '¤'. (Finally know what this symbol is made of...... and I have been using Word since version 2.0...... go figure :doh:..... This will not look good on my résumé)).

No need to reply if that is correct. Thanks for taking the time to get me straightened out.

Dave

Quote:

---

Originally Posted by DaveM

OK, Paul, so I think I'm square with your code:

..... use of the character class ([^13^l]) in the .Find function to replace all LineFeeds (^13) and FormFeeds/Page Breaks (^L) with a paragraph mark (pilcrow -
¶)

---

No, page breaks are not replaced (and it's ^l not ^L). Moreover, it's ^13 that finds paragraph breaks and ^l that finds manual line breaks (aka formfeeds).

And the pilcrow is just a pilcrow - not a paragraph break (though Word uses pilcrow symbols to display paragraph breaks - just as it uses '¤'symbols to display end-of-cell and end-of-row markers).

Quote:

---

Originally Posted by DaveM

the end-of-row in a table is a pair of characters (Chr(13)+Chr(7)), represented by '¤'.

---

The same '¤'symbol is used to display both end-of-cell markers and end-of-row markers. End-of-row markers are typically hidden.

Sorry to have muddied the water again; should not have mentioned Page Breaks. Outside of the Microsoft realm ^l represents both FormFeeds and PageBreaks. Within Microsoft ^l is the line break that one achieves by pressing Shift-<Enter>. And ^13 is what one gets when pressing <Enter>.

By referencing ^L, I meant to remove any ambiguity as to what character ^l was referring to (l not 1 or I). I realize that Microsoft does not consider ^L the same as ^l.

I also see that your use of the pilcrow symbol in the replacement text of your F/R command is merely a placeholder for later replacement (and not the actual Microsoft paragraph mark).

With that, I guess I will recede into the lurkdom.

Dave