vba - runtime error 5854 string parameter is too long

Question

I use following macro and sometimes it gives parameter is too long error. how can I solve it?

Sub BoldFirstLetterInSentence()
Dim s As Range
Dim doc1 As Document
Dim doc2 As Document

Set doc1 = Word.Documents("Doc1.docx")
Set doc2 = Word.Documents("Doc2.docx")

For Each s In doc1.Sentences
    If s.Characters(1).Bold = True Then
        Debug.Print s
        With doc2
            Selection.Find.ClearFormatting
            With Selection.Find
                .Text = s
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            a = Selection.Find.Execute
            If a = True Then
                Selection.Font.Bold = True
            End If
        End With
    End If
Next

End Sub

Answer 1

I figured out an answer to this - hopefully it's of some use 3 years on.

In my application, I'm replacing all occurrences of the string "{Text}" in a document with the replacement text.

The approach is to break the replacement text into "chunks" of 250 characters, and if there are any more chunks remaining, append a new replacement variable ({1} for the first chunk, {2} for the second, etc.), then repeat.

My code below runs in Word 2010 VBA:

Private Sub SearchAndReplace(search As String, replace As String)

Dim i As Integer
Dim chunks As Integer
Dim chunk As String

Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst ' Go to the start of the document

With Selection.Find
    .ClearFormatting
    .MatchCase = True
    .MatchWholeWord = True

    ' We get error 5854 if the replacement text is greater than 255 characters, so need to work around
    ' How many 250 character "chunks" are there in the replacement text?
    chunks = Round(Len(replace) / 250, 0)                   ' Use 250 to allow for {1}, etc.
    If Len(replace) Mod 250 > 0 Then chunks = chunks + 1      ' Workaround because there's no Ceiling()

    If chunks = 1 Then
        .Execute FindText:="{" & search & "}", ReplaceWith:=replace, replace:=wdReplaceAll
    Else

        ' Replace existing replacement variable (e.g. {Text}) the first chunk's replacement variable (i.e. {1})
        .Execute FindText:="{" & search & "}", ReplaceWith:="{1}", replace:=wdReplaceAll

        ' Replace the text in chunks of less than 255 characters
        For i = 1 To chunks

            ' Get the
            chunk = Mid(replace, ((i - 1) * 250) + 1, 250)

            ' Add the replacement variable for the next chunk to the end of the string
            If i < chunks Then chunk = chunk & "{" & (i + 1) & "}"

            .Execute FindText:="{" & i & "}", ReplaceWith:=chunk, replace:=wdReplaceAll
        Next i

    End If
End With

End Sub