Excel - Generating output Word file from Word template documents - excel

Question

I have a simple excel VBA routine to use template text files and replace key tags in them with values from an Excel array, with variable rows/columns. It works great, and has saved me tons of time for the last couple of years.
Now I need to do the same thing, but read/export a word document.
It's KILLING me. I've tried to follow numerous examples, but all I get is an output file that's the un-modified template pages that I'm using; all the original keywords that I'm searching for, but none of the replacements, even when my debug feed is showing positive hits for all keys.
Public Sub LogicGen(ActiveSheet As String)
On Error Resume Next
DebugMode = True 'Prints some extra data to the debugger window
'Variables
Dim Filename As String
Dim WorkbookPath As String
Dim KeyInput As Variant
Dim i As Integer
Dim END_OF_STORY
Dim MOVE_SELECTION
END_OF_STORY = 6
MOVE_SELECTION = 0
'Activate a worksheet
Worksheets(ActiveSheet).Activate
'Figure out how many keys were entered
i = 2
KeyInput = Cells(6, i)
Do Until IsEmpty(KeyInput)
i = i + 1
KeyInput = Cells(6, i)
Loop
' Key count is the empty address minus 2
KeyCount = i - 2
' push those keys into an array
Dim KeyArray() As String
ReDim KeyArray(0 To KeyCount) As String
For i = LBound(KeyArray) To UBound(KeyArray)
KeyArray(i) = Cells(6, i + 2)
If DebugMode Then
'Debug.Print KeyArray(i)
End If
Next i
'KeyArray now has all of the key values, which will be reused for each of the tags
WorkbookPath = ActiveWorkbook.Path
'Determine how many rows are populated by counting the template cells
TemplateInput = Cells(7, 1)
RowCount = 0
Do Until IsEmpty(TemplateInput)
RowCount = RowCount + 1
TemplateInput = Cells(RowCount + 7, 2)
Loop
OutputFilePath = WorkbookPath & "\" & Cells(1, 2)
'Create an output file
On Error Resume Next
Set OutputApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set OutputApp = CreateObject("word.application")
End If
On Error GoTo 0
Set OutputDoc = OutputApp.Documents.Add
Set OutputSelection = OutputApp.Selection
'build a Build a 2D array for the tag values, with the associated
'tag values.
Dim TagArray() As String
ReDim TagArray(0 To RowCount, 0 To KeyCount)
' Step down through all of the rows that have been entered
For i = 0 To RowCount - 1
'Build an array of all of the tags
For KeyIndex = 0 To KeyCount
TagArray(i, KeyIndex) = Cells(i + 7, KeyIndex + 2).Text
If DebugMode Then
'Debug.Print TagArray(i, KeyIndex)
End If
Next KeyIndex
'Ensure template file exists, once per row
Filename = WorkbookPath & "\" & Cells(i + 7, 1).Text
' Check for existance of template file, and open if it exists
If Not FileFolderExists(Filename) Then
MsgBox (Filename & " does not exist")
GoTo EarlyExit
Else
'Grab the template file and push it to the output
Set TemplateApp = CreateObject("word.application")
Set TemplateDoc = TemplateApp.Documents.Open(Filename)
Set TemplateSel = TemplateApp.Selection
TemplateDoc.Range.Select
TemplateDoc.Range.Copy
OutputSelection.endkey END_OF_STORY, MOVE_SELECTION
OutputSelection.TypeParagraph
OutputSelection.Paste
'Clear the template file, since we don't know if it will be the same next time
TemplateDoc.Close
TemplateApp.Quit
Set TemplateApp = Nothing
End If
'Iterate through all of the keys to be replaced
For j = 0 To KeyCount - 1
For Each storyrange In OutputDoc.StoryRanges
Do
With storyrange.Find
.Text = KeyArray(j)
.Replacement.Text = TagArray(i, j)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
If .Execute(Replace:=wdReplaceAll) Then
Debug.Print "Replacing: " & KeyArray(j) & " With: " & TagArray(i, j)
End If
End With
Set storyrange = storyrange.nextstoryrange
Loop While Not storyrange Is Nothing
Next
Next j
Next i
OutputDoc.SaveAs (OutputFilePath)
EarlyExit:
' Close the files that were opened
OutputDoc.Close
OutputApp.Quit
Set OutputDoc = Nothing
Even though my debug monitor is full of stuff like:
Replacing: %EULow% With: 0
Replacing: %EUHigh% With: 100
Replacing: %AlarmHH% With: No HH
Replacing: %AlarmH% With: No H
Replacing: %AlarmL% With: No L
My output document is still numerous pages of Word tables with the %something% tags not replaced. I'm going mad - I've been working on this all day.
This is where it's breaking down:
For Each storyrange In OutputDoc.StoryRanges
Do
With storyrange.Find
.Text = KeyArray(j)
.Replacement.Text = TagArray(i, j)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
If .Execute(Replace:=wdReplaceAll) Then
Debug.Print "Replacing: " & KeyArray(j) & " With: " & TagArray(i, j)
End If
End With
Set storyrange = storyrange.nextstoryrange
Loop While Not storyrange Is Nothing
Next
I've tried to do this search and replace probably 7 different ways from different examples, nothing actually replaces the text.

Answer 1

The problem is almost certainly that you are using "late binding" (which is fine), and are not referencing the Word object model, which means that constants defined by the Word Object model such as "wdFindContinue" and "wdReplaceAll" will be "empty". The values in the Word Object model are 1 and 2, respectively.
You can either reference the Word object model (there are advantages and disadvantages of doing so) via VB Editor's Tools->References menu, and reference the constants in it, or define your own constants with the same name and the correct values, or just use the correct constant values.
If you choose to reference the Word Object model, VBA should pick up the Word constant values with no additional qualification, i.e.
debug.print wdReplaceAll
should now display "2" in the Immediate window>
However, some people prefer to spell out the origin of these constants, e.g. via
Word.wdReplaceAll
or to be even more specific
Word.wdReplace.wdReplaceAll
If you want to see the Debug.Print output, you should also delete the first .Execute Replace:=ReplaceAll in your code (because it will then work properly, so the search string will not be found when the second .Execute method is called).