上記のように、これを行うためのより良い方法は、テーブルを調べてブックマークを見つけることです。以下の私のスクリプトは、最初のテーブルの2番目の列を調べて、すべてのブックマークを探します。見つかったブックマークは、他のドキュメント「DocumenttoPopulate.docx」で設定したブックマークに対応しています。ActiveDocumentからのデータは、次のようにブックマークが見つかった場合は常に2番目のドキュメントに入力されます。
Sub AutomateQuestionnaire2()
' Prototype 2
' Different approach was used, instead of looping through bookmarks, loop
' through the tables looking for bookmarks. This method is more flexible
' and is better suited for our Word documents which always include tables.
' Limitations: Bookmark needs to be in both documents using the same ID, and
' data must be in a table, column 2.
Dim oRow As Row
Dim oRange As Range
Dim oFindRange As Range
Dim oBookmark As Bookmark
Dim oQuestionnaire As Word.Document
Dim oApp As Word.Application
Dim strFilePath As String
Dim strText As String
strFilePath = ActiveDocument.Path
'Open the second to populate it
Set oApp = New Word.Application
oApp.Visible = True
Set oQuestionnaire = oApp.Documents.Open(strFilePath + "\Document to Populate.docx")
'We'll loop through each row of the table looking for bookmarks, if a bookmark is found
'the text adjacent to that bookmark, in the table cell, will be copied to the same
'bookmark if found in the questionnaire.
For Each oRow In ActiveDocument.Tables(1).Rows
'Limits the range to the middle column as is the case for the ITGC 532 form
Set oRange = oRow.Cells(2).Range
Set oBookmark = oRange.Bookmarks(1)
'VBA will terminate the script if it comes across an error, instead
'let's add some error handling to skip errors.
On Error GoTo SkipToNext
strText = oRange.Text
oQuestionnaire.Bookmarks(oBookmark).Range.Text = strText
'Find the newly inputted text and differentiate it (bold for now)
Set oFindRange = oQuestionnaire.Content
oFindRange.Find.Execute FindText:=strText, Forward:=True
If oFindRange.Find.Found = True Then oFindRange.Font.ColorIndex = wdBlue
SkipToNext:
Next