Search and 'Replace' parameter too long?

[Let2Editor]

I am writing a search and replace routine as follows:

With Selection.Find
.Text = sText
.Replacement.Text = rText
.Forward = True
.Wrap = wdFindContinue
isdone = .Execute(Replace:=wdReplaceAll)
End With

If the rtext variable is > 255 characters, I get an error that says string
parameter too long. I frequently have replacement text that exceed 255
characters and this is a real pain. Any good work arounds? This is not
documented anywhere that I can find on the MS site. Thanks.

Ed

 

[Helmut Weber]

Hi Ed,
tough, really tough, but have a look at this one,
and ask again for details, if necessary:

Sub ReplaceLong(sFind$, sRepl$)
Dim l As Long
Dim p1 As Long
Dim p2 As Long
Dim sArrF() As String ' the text to be found
Dim lFind As Long
Dim r As Range

lFind = (Len(sFind) / 50)
ReDim sArrF(lFind)
For l = 0 To lFind
If Len(sFind) > 50 Then
sArrF(l) = Left(sFind, 50)
sFind = Right(sFind, Len(sFind) - 50)
Else
sArrF(l) = sFind
Exit For
End If
Next

Set r = ActiveDocument.Range
With r.Find
.Text = sArrF(0)
If .Execute Then
p1 = r.Start
r.Select
For l = 1 To lFind
r.Start = r.End
r.End = r.End + Len(sArrF(l))
If r.Text = sArrF(l) Then
r.Select
p2 = r.End
End If
Next
End If
End With
r.Start = p1
r.End = p2
r.Text = sRepl
End Sub
' ---
Sub longtest()
Dim sF As String
Dim sR As String
sF = ActiveDocument.Paragraphs(1).Range.Text
sF = Left(sF, Len(sF) - 1)
sR = ActiveDocument.Paragraphs(2).Range.Text
sR = Left(sR, Len(sR) - 1)
ReplaceLong sF, sR
End Sub

You may modify this according to your needs.
E.g. the length of 50 was for my testing only.
The cutting off of the paragraph mark may be not
necessary, as well.

And lots of improvements possible.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Greg]

Helmut,

I played with your code a bit and was running into glitches. It would
find only the first occurence of the string and then stop. I took the
liberty to modify it as posted. I am really weak in the area of
passing variables and using functions. The use of the Esc variable
might be redundant, but I didn't know of any other way to define the
loop criteria. If you can, please provide feedback:

Sub FindReplaceLongStrings()
Dim txtFind As String
Dim txtReplace As String
Dim sF As String
Dim sR As String
Dim Esc As Boolean

txtFind = InputBox("Enter text string to find.")
txtReplace = InputBox("Enter replacement string.")

ActiveDocument.Range(0, 0).Select
Do
sF = txtFind
sR = txtReplace
Esc = ReplaceLong(sF, sR)
Loop While Esc = True
End Sub
Function ReplaceLong(sFind$, sRepl$) As Boolean
Dim l As Long
Dim p1 As Long
Dim p2 As Long
Dim sArrF() As String ' the text to be found
Dim lFind As Long
Dim r As Range

ReplaceLong = False

lFind = (Len(sFind) / 50)
ReDim sArrF(lFind)
For l = 0 To lFind
If Len(sFind) > 50 Then
sArrF(l) = Left(sFind, 50)
sFind = Right(sFind, Len(sFind) - 50)
Else
sArrF(l) = sFind
Exit For
End If
Next
Set r = Selection.Range
With r.Find
.Text = sArrF(0)
If .Execute Then
ReplaceLong = True
p1 = r.Start
For l = 1 To lFind
r.Start = r.End
r.End = r.End + Len(sArrF(l))
If r.Text = sArrF(l) Then
p2 = r.End
End If
Next
r.Start = p1
r.End = p2
r.Text = sRepl
End If
End With
End Function

 

[Dave Lett]

Hi Ed,

You might be able to use the clipboard to get what you want. For example,
you could define your string, place it in the clipboard, find the text and
replace it with the clipboard contents, as in the following example:

Dim MyData As DataObject
Dim rText As String
Dim sText As String
sText = "Test"
''' or some other way to set the string value
rText = "string that is longer than 255 characters"

Set MyData = New DataObject

MyData.SetText rText
MyData.PutInClipboard

With Selection.Find
.Text = sText
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
isdone = .Execute(Replace:=wdReplaceAll)
End With

HTH,
Dave

 

[Greg]

Helmut,

I spotted an error in my earlier code. If the search string was less
than 50 characters a circular loop occured.

Here is the corrected function:

Function ReplaceLong(sFind$, sRepl$) As Boolean
Dim l As Long
Dim p1 As Long
Dim p2 As Long
Dim sArrF() As String ' the text to be found
Dim lFind As Long
Dim r As Range

ReplaceLong = False

lFind = (Len(sFind) / 50)
ReDim sArrF(lFind)
For l = 0 To lFind
If Len(sFind) > 50 Then
sArrF(l) = Left(sFind, 50)
sFind = Right(sFind, Len(sFind) - 50)
Else
sArrF(l) = sFind
Exit For
End If
Next
Set r = Selection.Range
With r.Find
.Text = sArrF(0)
If .Execute Then
ReplaceLong = True
p1 = r.Start
p2 = r.End 'Added this line.
For l = 1 To lFind
r.Start = r.End
r.End = r.End + Len(sArrF(l))
If r.Text = sArrF(l) Then
p2 = r.End
End If
Next
r.Start = p1
r.End = p2
r.Text = sRepl
End If
End With
End Function

 

[Helmut Weber]

Hi Submariner,

I played with your code a bit and was running into glitches. It would
find only the first occurence of the string and then stop.

Very true.

I had been so obsessed with this challenge,
that I stopped thinking when I saw what I meant to be a success.

There are a million ways to complete the code.

Sure, using a boolean return value would be a way,
and looping while the return value is true.
Your solution seems to work perfectly.

Another way would be, to put in a simple "goto",
as you see, and put
r.Start = p1
r.End = p2
r.Text = sRepl
into the "If .Execute" condition.

Not very elegant, though.
' -----------------
Sub ReplaceLong(sFind$, sRepl$)
Dim l As Long
Dim p1 As Long
Dim p2 As Long
Dim sArrF() As String ' the text to be found
Dim lFind As Long
Dim r As Range

lFind = (Len(sFind) / 50)
ReDim sArrF(lFind)
For l = 0 To lFind
If Len(sFind) > 50 Then
sArrF(l) = Left(sFind, 50)
sFind = Right(sFind, Len(sFind) - 50)
Else
sArrF(l) = sFind
Exit For
End If
Next

again:
Set r = ActiveDocument.Range
With r.Find
.Text = sArrF(0)
If .Execute Then
p1 = r.Start
r.Select
For l = 1 To lFind
r.Start = r.End
r.End = r.End + Len(sArrF(l))
If r.Text = sArrF(l) Then
r.Select
p2 = r.End
End If
Next
r.Start = p1
r.End = p2
r.Text = sRepl
GoTo again
End If
End With
End Sub
' -------------------
Sub longtest()
Dim sF As String
Dim sR As String
sF = ActiveDocument.Paragraphs(1).Range.Text
sF = Left(sF, Len(sF) - 1)
sR = ActiveDocument.Paragraphs(2).Range.Text
sR = Left(sR, Len(sR) - 1)
ReplaceLong sF, sR
End Sub

And for co-readers,
don't forget to watch search options.
Like "resetsearch", posted a hundred times here.

Greetings from Bavaria, Germany,
where all and everything is covered with mountains of snow

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Greg]

Helmut,

Your solution is very clever. While Dave's method of using the
clipboard works for Replace, I don't know how, or if, you could use the
clipboard for both search and replace strings longer than 254
characters.

I have since realized that the input box in not suitable for defining
the long string (> 254 characters). I have since altered my version to
get the strings from a separate document:

Dim oSourceDoc As Document

Set oSourceDoc = Documents.Open(FileName:="C:\Test.doc")
txtFind = oSourceDoc.Paragraphs(1).Range.Text
txtReplace = oSourceDoc.Paragraphs(2).Range.Text
oSourceDoc.Close

WRT the Boolean return value. I am not very familiar with passing
information between routines. It seems like I should be able to
control the loop without the added value Esc. Something like


Do
sF = txtFind
sR = txtReplace
ReplaceLong(sF, sR)
Loop While ReplaceLong = True

but that doesn't work.

Profunde Cogitate
Greg

 

[Helmut Weber]

Hi Greg,

I didn't look into your code any more,
as my first approach was way tooooo complicated.

We better search for the left 256 characters
of the long string, and if found, extend the
range to the full length of the search string.
Then
if rDcm.Text = sFind ...

No array needed at all.

One could even think of extending this to
check for formatting.

Sub ReplaceLong(sFind$, sRepl$)

Dim lFnd As Long
Dim rDcm As Range

Dim sFind1 As String ' left part of long string
Dim sFind2 As String ' right part of long string

sFind1 = Left(sFind, 256)
sFind2 = Right(sFind, Len(sFind) - 256)
lFnd = Len(sFind2)

Set rDcm = ActiveDocument.Range
Repeat:
With rDcm.Find
.Text = sFind1
If .Execute Then
rDcm.End = rDcm.End + lFnd
' rDcm.Select ' for testing
If rDcm.Text = sFind Then
rDcm.Text = sRepl
' rDcm.Select ' for testing
rDcm.Collapse Direction:=wdCollapseEnd
End If
GoTo Repeat
End If
End With
End Sub

Of course, there is no error handling
but that didn't seem to be any kind of challenge.

Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[Helmut Weber]

Hi Greg,

WRT the Boolean return value. I am not very familiar with passing
information between routines. It seems like I should be able to
control the loop without the added value Esc.

I'm not too good at that either.

Maybe like this, though already a bit spartan spartan,
as Jean-Guy once called my style of coding.
At least, he conceded me a style. ;-)

While ReplaceLong(sF, sR)
Wend

Given, the "goto" was removed from my last example, of course.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Dave Lett]

HI Greg,

I'm fairly certain that you cannot use the clipboard for the Find string.
However, if you have a Find string that exceeds 255 characters, then you
could get somewhat clever with the Right() and Left() statements and
wildcard searching, as in the following:

Dim MyData As DataObject
Dim rText As String
Dim sText As String
sText = "Start my Test Test Test Test Test End my Test"
''' or some other way to set the string value
rText = "string that is longer than 255 characters"

Set MyData = New DataObject

MyData.SetText rText
MyData.PutInClipboard

With Selection.Find
.Text = Left(sText, 13) & "*" & Right(sText, 11)
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
isdone = .Execute(Replace:=wdReplaceAll)
End With

Now, I'm not arguing that this is fool proof by any stretch (for example,
the routine will find variations of sText). So, if the User knows that this
could be the case, the routine could be emended to

Dim MyData As DataObject
Dim rText As String
Dim sText As String
sText = "Start my Test Test Test Test Test Test Test Test Test Test Test
Test Test Test End my Test"
''' or some other way to set the string value
rText = "string that is longer than 255 characters"

Set MyData = New DataObject

MyData.SetText rText
MyData.PutInClipboard

With Selection.Find
.Text = Left(sText, 13) & "*" & Right(sText, 11)
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
If Selection.Text = sText Then
Selection.Paste
Else
Selection.MoveRight
End If
Loop
End With

Still not the best solution, but still better than doing it manually.

Dave

 

[Greg]

Dave,

I could not get the DataObject to work. I don't seem to have the
Microsoft Forms library on my computer and don't know where to get it.

I have adapted your code as follows:

Sub ScratchMacro()

Dim rText As String
Dim sText As String
Dim oSourceDoc As Document

Set oSourceDoc = Documents.Open(FileName:="C:\Test.doc")
sText = oSourceDoc.Paragraphs(1).Range.Text
rText = oSourceDoc.Paragraphs(2).Range.Text
oSourceDoc.Close

ActiveDocument.Range(0, 0).Select
With Selection.Find
.Text = Left(sText, 125) & "*" & Right(sText, 125)
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
If Selection.Text = sText Then
Selection.Range.Text = rText
Else
Selection.MoveRight
End If
Loop
End With

End Sub

What was the intent of using Left 13 and Right 11 in your code? I
decided to use 125 in each to minimize finding strings that didn't
match. I don't suppose it matters much.

 

[Dave Lett]

Hi Greg,

Couldn't get the DataObject to work, hmm? You probably don't have a UserForm
in your project. I got that code directly from the article "Manipulating the
clipboard using VBA" at
http://word.mvps.org/faqs/macrosvba/ManipulateClipboard.htm.
The intent of using 13 and 11 in the Right/Left functions was pragmatic form
demonstration purposes only (13 characters in "Start my Test" and 11
characters in "End my Test", which was the start/end of my string variable
sText). I, too, thought of making the string longer (i.e., 100 instead of
your 125), but I didn't only because the string the original poster was
referencing might not _always_ be longer than that. However, it's a custom
routine, so all hedges are off, I guess.

Dave

 

[Greg]

Dave,

You were right. No UserForm. I think I am going to stick with what I
have and not go back and use the DataOject method. Good to know
though.

I post a few Word tips on my website from time to time. This seems
like a useful and interesting tip. With your permission, I would like
to post a variation of your method with a mention of you and Helmut
Weber for helping me work through it.

I put a couple of conditions in to handle find and replace strings less
than 250. Can you explain for me how the "*" in the find string works.
At first I thought that .MatchWildCards would have to be enabled, but
it doesn't. In fact the routine scatters if it is.


Sub LongStringFindReplace()

Dim rText As String
Dim sText As String
Dim oSourceDoc As Document
Dim bLngStr As Boolean

Set oSourceDoc = Documents.Open(FileName:="C:\Test.doc")
sText = oSourceDoc.Paragraphs(1).Range.Text
rText = oSourceDoc.Paragraphs(2).Range.Text
oSourceDoc.Close

ActiveDocument.Range(0, 0).Select

If Len(sText) > 254 Then
With Selection.Find
.Text = Left(sText, 125) & "*" & Right(sText, 125)
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
If Selection.Text = sText Then
Selection.Range.Text = rText
Else
Selection.MoveRight
End If
Loop
End With
ElseIf Len(rText) > 254 Then
With Selection.Find
.Text = sText
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
If Selection.Text = sText Then
Selection.Range.Text = rText
Else
Selection.MoveRight
End If
Loop
End With
Else
With Selection.Find
.Text = sText
.Replacement.Text = rText
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
End If
End Sub

 

[Dave Lett]

Hi Greg,

Sure, you can post to your website.

HA! I, in fact, _did_ have .MatchWildcards = True. I accidently took it
out, but it's a "sticky" setting, so my routine worked. Mine works with
..MatchWildcards and fails without it. Let me know how yours is working. If
we need to account for the wildcards, then we'll have to turn it off for the
other conditions (ElseIf and Else), which you could do very easily by
calling the routine from the article "Flush bad karma from Word's find
facility after an unsuccessful wildcard search" at
http://word.mvps.org/faqs/macrosvba/FlushFR.htm.

Dave

 

[Greg]

Dave,

You are right. I must have had something else not worked out when I
tried with UseWildCards. I cleared the settings and ran again and it
didn't work. Now I have the line to UseWildCards back in and it is
working as expected.

Thanks posting back.

 

[Dave Lett]

Greg,

Let's chat next week (I'm on my way out the door); we haven't covered the
following case

sText > 254 AND rText > 254

Looks like we might have an easier go if we use a Select statement.

Dave

 

[Greg Maxey]

Dave,

Will do. I don't think we need a case for sText > 254 AND rText > 254 or
even rText >254 for that matter. I have modified the code to copy the
replacement text to the clipboard regardless of length (see below). I found
a bug in the .Text = Left(sText, 125) & "*" & Right(sText, 125) technique.
I will try to explain.

If I left the paragraph mark in the find string (e.g., "aaaa¶") and replace
with bbbb, then the macro finds

aaaa¶ on a line by itself and replaces with bbbb¶ which is good, but it
also finds

aaaa...............aaaaaaa¶ and replaces with aaaa................aaabbbb¶
which is bad.

MatchWholeWords=True doesn't seem to prevent this.

When I removed the ¶ from the find string (e.g., "aaaa") the above problem
above was resolved, but a new problem cropped up.

If the find string was aaaa...............aaaa (lets say a string of 300)
then the macro failed to find the string in the text. I believe this is due
to the fact that the Left and Right portions of the .find string are
identical. The macro found the first 250 a's in the string. Since this
doesn't match srchTxt (300 a's) no replacement is made.

If I changed the find string to aaaa.........aaab(that is 299 a's and a "b")
then a replacement is made. The macro found the first 125 a's then a "b"
with the preceeding 124 a's and filled in the middle with the wildcard. The
paragraph mark was serving the purpose of the "b" prior to stripping it from
the string.

I worked out a method that appears to resolve both issues. I haven't been
able to break it, but maybe you, or Helmut or someone else following this
string can.

Sub LongStringFindReplace()

Dim oSourceDoc As Document
Dim srchTxt As String
Dim replaceRng As Range
Dim i As Long

'Define the find and replace strings in a separate document.
Set oSourceDoc = Documents.Open(FileName:="C:\Long String Source.doc")
'Establish find string
srchTxt = oSourceDoc.Paragraphs(1).Range.Text
srchTxt = Left(srchTxt, Len(srchTxt) - 1) 'Remove paragraph mark
'Establish replace text and copy to clipboard
Set replaceRng = oSourceDoc.Paragraphs(2).Range
replaceRng.MoveEnd Unit:=wdCharacter, Count:=-1 'Remove paragraph mark
replaceRng.Copy
oSourceDoc.Close

ActiveDocument.Range(0, 0).Select

If Len(srchTxt) > 250 Then
i = Len(srchTxt) - 250
With Selection.Find
.Text = Left(srchTxt, 250)
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
'Move end of selection to match length of srchTxt
Selection.MoveEnd Unit:=wdCharacter, Count:=i
'Compare selection to search string
If Selection.Text = srchTxt Then
'replace selction with clipboard contents
Selection.Paste
Else
Selection.MoveRight
End If
Loop
End With
Else
ResetFRParameters
With Selection.Find
.Text = srchTxt
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
End If
End Sub
Sub ResetFRParameters()

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

 

[Greg Maxey]

Helmut,

I think Dave Lett offers a good starting point. I have sort of married his
idea of using Do While with your idea of entending the selection range. If
you are interested, have a look at my last reply to Dave for an explanation
of why I have adopted this method.

Sub LongStringFindReplace()

Dim oSourceDoc As Document
Dim srchTxt As String
Dim replaceRng As Range
Dim i As Long

'Define the find and replace strings in a separate document.
Set oSourceDoc = Documents.Open(FileName:="C:\Long String Source.doc")
'Establish find string
srchTxt = oSourceDoc.Paragraphs(1).Range.Text
srchTxt = Left(srchTxt, Len(srchTxt) - 1) 'Remove paragraph mark
'Establish replace text and copy to clipboard
Set replaceRng = oSourceDoc.Paragraphs(2).Range
replaceRng.MoveEnd Unit:=wdCharacter, Count:=-1 'Remove paragraph mark
replaceRng.Copy
oSourceDoc.Close

ActiveDocument.Range(0, 0).Select

If Len(srchTxt) > 250 Then
i = Len(srchTxt) - 250
With Selection.Find
.Text = Left(srchTxt, 250)
.Forward = True
.Wrap = wdFindContinue
Do While .Execute
'Move end of selection to match length of srchTxt
Selection.MoveEnd Unit:=wdCharacter, Count:=i
'Compare selection to search string
If Selection.Text = srchTxt Then
'replace selction with clipboard contents
Selection.Paste
Else
Selection.MoveRight
End If
Loop
End With
Else
ResetFRParameters
With Selection.Find
.Text = srchTxt
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
End If
End Sub
Sub ResetFRParameters()

With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With