Error 5854 - String Parameter Too Long

[abitrandom82]

Hi All,

I created an excel sheet form with a macro that auto replacement texts specific excel cell entries into a designated word pad document.

Everything works perfectly until I saw that 3 of the cell ranges for the replacement texts cannot go over 251 characters or so. I found an old thread here:

string parameter too long error

Hey all, I am running into this error which is making things difficult when trying to find and replace. The error is: Run-time error '5854': String parameter too long I take it there is a character limit when using the find and replace and if there is a way around it, it would be GREAT...

www.mrexcel.com

that was helpful but I’m not sure how to implement the corrected code firefly posted on page 2 of this thread into my VB module.

below is a of part of my code and the areas called <<provider>> and <administrator>> and another one are the ranges that wont allow to go over 250 when the word pad document opens up (Debug Error 5854)

Option Explicit


Private Sub Create ()


Dim wb As Workbook


Dim ws As Worksheet, wsl As Worksheet, ws2 As Worksheet


Dim file As String


file = ActiveWorkbook.Path & "\" & "RMI.docx"


V


Dim word


_app As Object


Set word


app = CreateObject ("Word Application")


With word_app

• Visible - True

• WindowState - 1 value for waWindowStateMaximize

End With


Dim word_ fichier As Object


Set word fichier - word


app. Documents. Open (file)


With word


Text Echeereder names.

• Replacement .Text - Range ("H21")
• Execute Replace:-2 value for wdReplaceAll

End With


Dim word


Lichien2 As obJect


Set word fichier? = word


_app- Documents. Open (file)


With word


_fichier2. Range. Find

• Text - "<<Provider>>"
• Replacement. Text = Range ("K21")
• Execute Replace:=2 value for wdReplaceA11

End With


Dim word


_fichiers As Object


Set wora_Eichiers = word_apr.Documents.Open（file）


With word


_Hachier3.Range,Fand

• Text - "<<Administrator>>"
• Replacement. Text = Range ("R21")
• Execute Replace:=2 value for wdReplaceAll

End With


Dim word fichier4 As Object


Set word fichier4 = word app. Documents. Open (file)


With word


fichier4. Range.Find


-Text = "<<Analyst>>"

 

[abitrandom82]

Sorry, this is my correct VBA Code. The two areas I bolded are the ones that need 255+ characters in there. Please help.


Sub JorgieFWC()

Dim wb As Workbook
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet, ws6 As Worksheet, ws7 As Worksheet


Dim file As String
file = ActiveWorkbook.Path & "\" & "RMI.docx"


Dim word_app As Object
Set word_app = CreateObject("Word.Application")
With word_app
.Visible = True
.WindowState = 1 'value for wdWindowStateMaximize
End With

Dim word_fichier As Object
Set word_fichier = word_app.Documents.Open(file)
With word_fichier.Range.Find
.Text = "<<shelter name>>"
.Replacement.Text = Range("'FWC FO'!H21")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier2 As Object
Set word_fichier2 = word_app.Documents.Open(file)
With word_fichier2.Range.Find
.Text = "<<Provider>>"
.Replacement.Text = Range("'FWC FO'!K21")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier3 As Object
Set word_fichier3 = word_app.Documents.Open(file)
With word_fichier3.Range.Find
.Text = "<<Administrator>>"
.Replacement.Text = Range("'FWC FO'!R21")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier4 As Object
Set word_fichier4 = word_app.Documents.Open(file)
With word_fichier4.Range.Find
.Text = "<<Analyst>>"
.Replacement.Text = Range("'FWC FO'!O21")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier5 As Object
Set word_fichier5 = word_app.Documents.Open(file)
With word_fichier5.Range.Find
.Text = "<<review date>>"
.Replacement.Text = Range("'Metrics'!R5")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier6 As Object
Set word_fichier6 = word_app.Documents.Open(file)
With word_fichier6.Range.Find
.Text = "<<Facility Review>>"
.Replacement.Text = Range("'FWC FO'!C69")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier7 As Object
Set word_fichier7 = word_app.Documents.Open(file)
With word_fichier7.Range.Find
.Text = "<<Basic Services>>"
.Replacement.Text = Range("'FWC BS'!C169")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier8 As Object
Set word_fichier8 = word_app.Documents.Open(file)
With word_fichier8.Range.Find
.Text = "<<Security>>"
.Replacement.Text = Range("'FWC SEC'!C45")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier9 As Object
Set word_fichier9 = word_app.Documents.Open(file)
With word_fichier9.Range.Find
.Text = "<<FO Score>>"
.Replacement.Text = Range("'Metrics'!Q61")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier10 As Object
Set word_fichier10 = word_app.Documents.Open(file)
With word_fichier10.Range.Find
.Text = "<<BS Score>>"
.Replacement.Text = Range("'Metrics'!Q62")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier11 As Object
Set word_fichier11 = word_app.Documents.Open(file)
With word_fichier11.Range.Find
.Text = "<<SEC Score>>"
.Replacement.Text = Range("'Metrics'!Q63")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier12 As Object
Set word_fichier12 = word_app.Documents.Open(file)
With word_fichier12.Range.Find
.Text = "<<Total Score>>"
.Replacement.Text = Range("'Metrics'!M78")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier13 As Object
Set word_fichier13 = word_app.Documents.Open(file)
With word_fichier13.Range.Find
.Text = "<<Rating Word>>"
.Replacement.Text = Range("'Metrics'!Q24")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier14 As Object
Set word_fichier14 = word_app.Documents.Open(file)
With word_fichier14.Range.Find
.Text = "<<Due Date>>"
.Replacement.Text = Range("'Metrics'!Q5")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier15 As Object
Set word_fichier15 = word_app.Documents.Open(file)
With word_fichier15.Range.Find
.Text = "<<Chief>>"
.Replacement.Text = Range("'Controls'!V1")
.Execute Replace:=2 'value for wdReplaceAll
End With

Dim word_fichier16 As Object
Set word_fichier16 = word_app.Documents.Open(file)
With word_fichier16.Range.Find
.Text = "<<Associate>>"
.Replacement.Text = Range("'Controls'!V3")
.Execute Replace:=2 'value for wdReplaceAll
End With

End Sub

 

[Artik]

Try this:

Sub JorgieFWC_2()
    Dim file As String
    Dim word_app As Object
    Dim word_fichier As Object
    
    Const wdWindowStateMaximize As Long = 1


    file = ActiveWorkbook.Path & "\" & "RMI.docx"

    Set word_app = CreateObject("Word.Application")
    Set word_fichier = word_app.Documents.Open(file)

    With word_fichier.Range
            Call ReplaceText(.Find, "<<shelter name>>", Range("'FWC FO'!H21").Value)
            Call ReplaceText(.Find, "<<Provider>>", Range("'FWC FO'!K21").Value)
            Call ReplaceText(.Find, "<<Administrator>>", Range("'FWC FO'!R21").Value)
            Call ReplaceText(.Find, "<<Analyst>>", Range("'FWC FO'!O21").Value)
            Call ReplaceText(.Find, "<<review date>>", Range("'Metrics'!R5").Value)

            Call ReplaceText(.Find, "<<Facility Review>>", Range("'FWC FO'!C69").Value)
            Call ReplaceText(.Find, "<<Basic Services>>", Range("'FWC BS'!C169").Value)
        
            Call ReplaceText(.Find, "<<Security>>", Range("'FWC SEC'!C45").Value)
            Call ReplaceText(.Find, "<<FO Score>>", Range("'Metrics'!Q61").Value)
            Call ReplaceText(.Find, "<<BS Score>>", Range("'Metrics'!Q62").Value)
            Call ReplaceText(.Find, "<<SEC Score>>", Range("'Metrics'!Q63").Value)
            Call ReplaceText(.Find, "<<Total Score>>", Range("'Metrics'!M78").Value)
            Call ReplaceText(.Find, "<<Rating Word>>", Range("'Metrics'!Q24").Value)
            Call ReplaceText(.Find, "<<Due Date>>>", Range("'Metrics'!Q5").Value)
            Call ReplaceText(.Find, "<<Chief>>", Range("'Controls'!V1").Value)
            Call ReplaceText(.Find, "<<Associate>>", Range("'Controls'!V3").Value)

    End With
    

    With word_app
        .Visible = True
        .WindowState = wdWindowStateMaximize
    End With
    
    word_fichier.Save
    
    Set word_fichier = Nothing
    Set word_app = Nothing

End Sub


Sub ReplaceText(oFind As Object, findText As String, replaceTo As String)
    Dim strReplacement As String, strFragment As String
    Dim cnt As Long
    
    Const wdReplaceAll As Long = 2
    
    strReplacement = replaceTo
    
    With oFind
        .Text = findText
        
        If Len(strReplacement) > 255 Then
            strFragment = Mid(strReplacement, cnt + 1, 230) & "@@@@@@@@@@"
            cnt = cnt + 230
            .Replacement.Text = strFragment
            .Execute Replace:=wdReplaceAll
            .Text = "@@@@@@@@@@"

            Do
                strFragment = Mid(strReplacement, cnt + 1, 230)
                cnt = cnt + 230
                If Len(strFragment) > 0 Then strFragment = strFragment & "@@@@@@@@@@"
                .Replacement.Text = strFragment
                .Execute Replace:=wdReplaceAll
            Loop While Len(strFragment) > 0
            
        Else
            .Replacement.Text = strReplacement
            .Execute Replace:=wdReplaceAll
        End If
        
    End With
End Sub

Artik