[SOLVED] Excel VBA to find/replace text in Word Document (255 character limit)

Excel VBA to find/replace text in Word Document (255 character limit)

I'm trying to open a Word document, and then do find/replace to replace text that is in square brackets []. For the most part, this code works. But when I want to swap in a long sentence, I run against a character limit for ".Replacement.Text".

What is the simplest way to get around this limit? I looked at solutions involving copying to a clipboard, replacing the text with blank "" and inserting the text afterwards. But I do not know my away around Word documents in VB (activedocument, selections, story ranges...), and was unable to implement them.

'Open Word App
Dim wordApp As Object
Dim wordDoc As Object
Dim myStoryRange As Object

Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False

'Open Table2.doc
Set wordDoc = wordApp.Documents.Open(WIN_Path & "memo\table2_" & L_Effectivity & "_" & DEL_AIL & ".doc")

'Find/Replace using change_words
Dim myDict: Set myDict = CreateObject("Scripting.Dictionary")
myDict("[TABLE2_AUTHOR]") = Table2_Author
myDict("[JOB_NUMBER]") = Job_Number
myDict("[REGISTRATION]") = Registration
myDict("[EFFECTIVITY]") = Effectivity

For Each myStoryRange In wordDoc.StoryRanges
    For myLoop = 0 To myDict.Count - 1
        change_words myStoryRange, myDict.Keys()(myLoop), myDict.Items()(myLoop)
    Next
Next myStoryRange


Sub change_words(ByRef myStoryRange, ByVal findWord, ByVal replaceWord)
    With myStoryRange.Find
        .Text = findWord
        .Replacement.Text = replaceWord   '<<<<<<<CHARACTER LIMIT
        .Execute Replace:=2
    End With
End Sub

Solution

Replace the matched string one by one

Sub change_words(ByRef myStoryRange, ByVal findWord, ByVal replaceWord)
    With myStoryRange.Find
        .Text = findWord
'        .Replacement.Text = replaceWord   '<<<<<<<CHARACTER LIMIT
        Dim i As Long
        Do While .Execute And i < 2
            .Parent.Text = replaceWord
            .Parent.Collapse 0 ' Word.wdCollapseEnd
            i = i + 1
        Loop
    End With
End Sub

Dim destRange As Object
For Each myStoryRange In wordDoc.StoryRanges
    For myLoop = 0 To myDict.Count - 1
        Set destRange = myStoryRange.Duplicate
        change_words destRange, myDict.Keys()(myLoop), myDict.Items()(myLoop)
    Next
Next myStoryRange