Excel - Generating output Word file from Word template documents

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).