Copy tables from documents to another documents with predefined bookmarks

[Pearce]

Hello all,


I am looking for some assistance in a matter, not sure if best to do it in Excel or Word VBA; so I'll start with Word VBA.

I have an application that generates Word documents – each generated Word document contains named tables (TableA, TableB, ...). I’d like to copy all tables from these generated Word documents to existing documents IN predefined bookmark locations (named BookmarkA, BookmarkB, ...), i.e. TableA in BookmarkA, TableB in BookamrkB, etc.

For each generated Word document there is one existing Word document. So I’d like to copy all tables from the generated document X to the existing document X, all tables from the generated document Y to the existing document Y, all tables from the generated document Z to the existing document Z, etc…

Number of generated Word documents contain 4 tables (either TableA, TableB, TableC, TableE or TableA, TableB, TableD, TableE) and their corresponding existing documents contain 4 bookmarks (either BookmarkA, BookmarkB, BookmarkC, BookmarkE or BookmarkA, BookmarkB, BookmarkD, BookmarkE).
Most of generated Word documents contain 5 tables (TableA, TableB, TableC, TableD, TableE) and their corresponding target documents contain 5 bookmarks (BookmarkA, BookmarkB, BookmarkC, BookmarkD, BookmarkE).

Now as this is going to be somewhat repetitive task the content of the bookmarks in the existing documents need to be cleared first before copying the tables from the generated documents.
The generated (table source) documents are located in a different folder than the existing (target) documents. The corresponding source and target documents can be matched by the first 6 characters of a filename. I was wondering whether a list of matching source documents (column A) and target documents (column B) in an Excel would make thing easier.


I am new to VBA. I have searched for a similar problem to get me started but haven’t found any.
Any help or advice would be much appreciated.


Pearce

[Pearce]

I have tried to put together a code that would delete the contents of bookmarks using info from several VBA forums. It seems that being a new memeber the forum won't let me to post links to the sources in my message.

So far the code works only with a plain text - it deletes the text inside the bookmarks.

Next I will try to modify the code so that it would delete bookmarked tables using info from: rlbcontractor.com/vba-deleting-a-bookmarked-table-without-deleting-the-bookmark


Code:

Option Explicit

Sub ClearContentsOfBookmarks()
Application.ScreenUpdating = False

Dim strFolder As String
Dim strFile As String
Dim strName As String
Dim wdDoc As Document
Dim i As Long

strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)

While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
wdDoc.Activate
With wdDoc
For i = 1 To ActiveDocument.Bookmarks.Count
strName = ActiveDocument.Bookmarks(i).Name
FillBM strName, ""
Next i
End With
wdDoc.Close SaveChanges:=True
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = False
End Sub

Private Sub FillBM(strBMName As String, strValue As String)
'Graham Mayor
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
oRng.Text = strValue
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
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

[gmayor]

The following should help


Sub Macro1()Dim oRng As Range
Set oRng = ActiveDocument.Tables(1).Range
FillBM_with_Table "BM1", oRng
Set oRng = Nothing
End Sub


Private Sub FillBM_with_Table(strbmName As String, oSource As Range)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strbmName).Range
If oRng.Tables.Count > 0 Then oRng.Tables(1).Delete
oRng.FormattedText = oSource.FormattedText
oRng.Bookmarks.Add strbmName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

[Pearce]

Thank you gmayor for help.

The following code removes table located in a bookmark named "Bookmark1".


Option Explicit

Sub ClearBookmarks()
Application.ScreenUpdating = False

Dim strFolder As String
Dim strFile As String
Dim wdDoc As Document
Dim oRng As Range

strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)

While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
wdDoc.Activate
With wdDoc
Set oRng = ActiveDocument.Tables(1).Range
FillBM_with_Table "Bookmark1", oRng
Set oRng = Nothing
End With
wdDoc.Close SaveChanges:=True
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = False
End Sub

Private Sub FillBM_with_Table(strBMName As String, oSource As Range)
'Graham Mayor
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
If oRng.Tables.Count > 0 Then oRng.Tables(1).Delete
oRng.FormattedText = oSource.FormattedText
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
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


I have tried to modify the code so that it loops through every bookmark in the document and deletes tables in bookmarks. However so far my attempts have been fruitless. e.g.

Option Explicit

Sub ClearBookmarks()
Application.ScreenUpdating = False

Dim strFolder As String
Dim strFile As String
Dim strName As String
Dim wdDoc As Document
Dim i As Long
Dim oRng As Range

strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)

While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
wdDoc.Activate
With wdDoc
Set oRng = ActiveDocument.Tables(1).Range
For i = 1 To ActiveDocument.Bookmarks.Count
strName = ActiveDocument.Bookmarks(i).Name
FillBM_with_Table strName, oRng
Next i
Set oRng = Nothing
End With
wdDoc.Close SaveChanges:=True
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = False
End Sub

Private Sub FillBM_with_Table(strBMName As String, oSource As Range)
'Graham Mayor
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
If oRng.Tables.Count > 0 Then oRng.Tables(1).Delete
oRng.FormattedText = oSource.FormattedText
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
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

Any help or advice would be greatly appreciated.

[gmayor]

To delete tables that are in bookmarks


Sub ClearBookmarks()Dim strFolder As String
Dim strFile As String
Dim strName As String
Dim wdDoc As Document
Dim i As Long
Dim oRng As Range


strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)


Application.ScreenUpdating = False


While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
wdDoc.Activate
With wdDoc
For i = 1 To .Bookmarks.Count
strBMName = .Bookmarks(i).Name
Set oRng = .Bookmarks(strBMName).Range
If oRng.Tables.Count > 0 Then oRng.Tables(1).Delete
oRng.Bookmarks.Add strBMName
Next i
.Close SaveChanges:=True
Set oRng = Nothing
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Private 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

[Pearce]

Thank you very much!

I have managed to put together a code that copies table from one document and pastes it into antother document into predefined bookmark.


Option Explicit
Option Base 1

Sub CopyTablesFromDoc2Doc()

Dim oSourceDoc As Document
Dim oTargetDoc As Document
Dim oRng As Word.Range


'Optimize Code
Application.ScreenUpdating = False

Set oSourceDoc = Documents.Open("C:\Source\001_01_Source_VK.docx")
Set oTargetDoc = Documents.Open("C:\Target\001_01_Target_VK.docx")

With oTargetDoc
Set oRng = .Bookmarks("TabObce").Range
oRng.FormattedText = oSourceDoc.Tables(1).Range.FormattedText
.Bookmarks.Add "TabObce", oRng
Set oRng = .Bookmarks("TabDemografie").Range
oRng.FormattedText = oSourceDoc.Tables(2).Range.FormattedText
.Bookmarks.Add "TabDemografie", oRng
End With

oSourceDoc.Close
oTargetDoc.Save
oTargetDoc.Close

End Sub

I have tried to select the tables from the source document by their title using a function but to no avail. Any piece of advice will be much appreciated.



Sub CopyTablesFromDoc2Doc()

....
With oTargetDoc
Set oRng = .Bookmarks("TabObce").Range
Set oSourceTable = getTableByTitle("TabA")
oRng = oSourceTable.Range
oRng.FormattedText = oSourceDoc.Tables(1).Range.FormattedText
....
End Sub

Function getTableByTitle(tabTitle As String) As Table
Dim shape As Variant

For Each shape In oSourceDoc.Tables
If shape.Title = tabTitle Then
getTableByTitle = shape
Exit Function
End If
Next
End Function

As a next step I will try to incorporate a loop through the source and target documents.

[Pearce]

Today I came across a post by gmayor in the topic "Read Excel Cell from Word VBA" in this forum.

I have used the xlFillArray function to read a worksheet into array. In the worksheet "SourceTarget" in the column A there are listed the source documents (e.g. C:\Source\001_01_Source_VK.docx) and in the column B there are listed the target documents (e.g. C:\Target\001_01_Target_VK.docx).


Option Explicit

Private Const strWorkbook As String = "C:\CopyTables\MatchingTables.xlsx" 'The path of the workbook
Private Const strSheet As String = "SourceTarget" 'The name of the worksheet

Sub CopyTablesFromDocs2Docs()

Dim oSourceDoc As Document
Dim oTargetDoc As Document
Dim oRng As Word.Range
Dim excelArray() As Variant
Dim excelArrayLen As Integer
Dim i As Integer

'Optimize Code
Application.ScreenUpdating = False

excelArray = xlFillArray(strWorkbook, strSheet)

excelArrayLen = UBound(excelArray, 2) - LBound(excelArray, 2) + 1


For i = 1 To excelArrayLen

Set oSourceDoc = Documents.Open(excelArray(0, i - 1))
Set oTargetDoc = Documents.Open(excelArray(1, i - 1))

With oTargetDoc
Set oRng = .Bookmarks("BookmarkA").Range
oRng.FormattedText = oSourceDoc.Tables(1).Range.FormattedText
.Bookmarks.Add "BookmarkA", oRng
Set oRng = .Bookmarks("BookmarkB").Range
oRng.FormattedText = oSourceDoc.Tables(2).Range.FormattedText
.Bookmarks.Add "BookmarkB", oRng
End With

Set oRng = Nothing

oSourceDoc.Close
oTargetDoc.Save
oTargetDoc.Close

Next

End Sub

Private Function xlFillArray(strWorkbook As String, _
strRange As String) As Variant
'Graham Mayor - 24/09/2016
Dim RS As Object
Dim CN As Object
Dim iRows As Long

strRange = strRange & "$]" 'Use this to work with a named worksheet
'strRange = strRange & "]" 'Use this to work with a named range
Set CN = CreateObject("ADODB.Connection")

'Set HDR=YES for a sheet or range with a header row
CN.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

Set RS = CreateObject("ADODB.Recordset")
RS.Open "SELECT * FROM [" & strRange, CN, 2, 1

With RS
.MoveLast
iRows = .RecordCount
.MoveFirst
End With
xlFillArray = RS.GetRows(iRows)
If RS.State = 1 Then RS.Close
Set RS = Nothing
If CN.State = 1 Then CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function

I will try to work out the selection of tables from the source documents by their title. I will be glad for any comment/help/advice. Thanks