selecting all tables in a document and also a line of text above and below each table

Question

selecting all tables in a document and also a line of text above and below each table

Anonymous

Hi,

I have multiple documents that contain several tables in them. I want to either (a) extract the data in those tables along with 1 line of text above and below the tables, or (b) add a 1 row table above and below the existing tables and populate with the lines of text above and below. If the line contains spaces or is the beginning or end of the document then the table will be populated with some default eg "no text above", "no text below".

I have found some vba code and macros that can extract all the tables from 1 document or from all documents in a folder so option (b) is preferred.

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

Answer accepted by question author

Paul Edstein 82,861 Volunteer Moderator

The following code will extract all tables from the documents in the selected folder, plus the paragraph before & after (Word doesn't really work with lines):

Sub GetTableData()

Application.ScreenUpdating = False

Dim DocTgt As Document, DocSrc As Document, Tbl As Table, Rng As Range

Dim strFolder As String, strFile As String

strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit

Set DocTgt = ActiveDocument

strFile = Dir(strFolder & "\*.doc", vbNormal)

While strFile <> ""

Set DocSrc = Documents.Open(FileName:=strFolder & "" & strFile, AddToRecentFiles:=False, Visible:=False)

With DocSrc

For Each Tbl In .Tables

Set Rng = Tbl.Range

Rng.MoveStart wdParagraph, -1

Rng.MoveEnd wdParagraph, 1

With DocTgt.Range

.Characters.Last.FormattedText = Rng.FormattedText

End With

strFile = Dir()

Wend

ErrExit:

Set DocTgt = Nothing: Set DocSrc = 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

0 comments

3 additional answers

Answer 1

Paul Edstein 82,861 Volunteer Moderator

Using:

Dir(strFolder & "\*.doc", vbNormal)

will pick up all files with .doc in their extension (i.e. .doc, .docx, & .docm).

As for inserting the filenames, you could insert:

.Characters.Last.InsertBefore strFile & vbCr

before:

.Characters.Last.FormattedText = Rng.FormattedText

0 comments

Answer 2

Using:

Dir(strFolder & "\*.doc", vbNormal)

will pick up all files with .doc in their extension (i.e. .doc, .docx, & .docm).

As for inserting the filenames, you could insert:

.Characters.Last.InsertBefore strFile & vbCr

before:

.Characters.Last.FormattedText = Rng.FormattedText

Hi Paul,

Thanks again for that additional piece of code it places the filename before each table extract.

I tested again and the Dir(strFolder & "\.doc", vbNormal) did not pick up docx or docm however I rectified this by placing wild character after .doc, Dir(strFolder & "\.doc*****", vbNormal) it then picked up extensions .doc, .docx, & .docm.

Thank you very much

Regards

John

Answer 3

Hi Paul,

That worked perfectly : ) I just needed to change this ;

strFile = Dir(strFolder & "\*.doc", vbNormal.

My document was docx

I also used a htm document in the folder changed the above line and that worked also.

Is it an easy change to insert the file name for each file in the folder before each extract of the file ?

Many thanks for what you have already provided

Kindest Regards

John

Share via

selecting all tables in a document and also a line of text above and below each table

3 additional answers