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: test.docx). 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.
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