RUNTIME ERROR 5174

[nmkhan3010]

Hi am having mass replacing code but it is throwing error.. can any one help me in this regards ..

Run time error 5174

Is there any code for replacing a text containing morethan 250 Chars.... can anyone insert this into the below macro




Public Sub MassReplaceQ1()
Dim Directory As String
Dim FType As String
Dim FName As String
Directory = InputBox("PLEASE ENTER PATH", "SELECT THE TARGET FOLDER") & "\"
FType = "*.docx"
ChDir Directory
FName = Dir(FType)
' for each file you find, run this loop
Do While FName <> ""
' open the file
Documents.Open FileName:=FName
' search and replace the company name
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
Selection.find.Replacement.Font.Name = "Angsana New"
Selection.find.Replacement.Font.Bold = True
Selection.find.Replacement.Font.Color = wdColorRed
With Selection.find
.Text = "preferred \\\stock / Inventory"
.MatchCase = True
.Replacement.Text = "preferred stock"
End With
Selection.find.Execute Replace:=wdReplaceAll
With Selection.find
.Text = "Cash received from return on investment income"
.Replacement.Text = "Cash received from investment income"
End With
Selection.find.Execute Replace:=wdReplaceAll
With Selection.find
.Text = "Reinsurance Accounts payable"
.Replacement.Text = "Reinsurance payable"
End With
Selection.find.Execute Replace:=wdReplaceAll
With Selection.find
.Text = "Of which:"
.Replacement.Text = "Including"
End With
Selection.find.Execute Replace:=wdReplaceAll
With Selection.find
.Text = "(1) "
.Replacement.Text = "(1)"
End With
Selection.find.Execute Replace:=wdReplaceAll
With Selection.find
.Text = "(2)"
.Replacement.Text = "(2)"
End With
Selection.find.Execute Replace:=wdReplaceAll
With Selection.find
.Text = "common \\\stock / Inventory"
.Replacement.Text = "common stock"
End With
Selection.find.Execute Replace:=wdReplaceAll
With Selection.find
.Text = ""
.Replacement.Text = ""
End With
Selection.find.Execute Replace:=wdReplaceAll
' save and close the current document
ActiveDocument.Close wdSaveChanges
' look for next matching file
FName = Dir
Loop
End Sub

[macropod]

Nothing in your posted code is trying to find or replace is more than 250 characters. That said, it could be made far more efficient.

If you have strings of more than 255 characters to find, you should consider using wildcards so the string can be shortened.

If you have strings of more than 255 characters to replace with, you should consider using the clipboard, as demonstrated in the following example.

Sub UpdateDocuments()
'Note: This code requires a reference to the MS Forms 2.0 Object Library.
'See under Tools|References in the VBE. You may need to browse to and select C:\Windows\SysWOW64\FM20.DLL
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim Rng As Range, i As Long, ArrFnd(), ArrRep(), RepObj As DataObject
'Insert Find & Replace expressions here. The arrays must have the same # of entries
ArrFnd = Array( _
"preferred \\\stock / Inventory", _
"Cash received from return on investment income", _
"Reinsurance Accounts payable", _
"Of which", _
"(1) ", _
"(2) ", _
"common \\\stock / Inventory" _
)
ArrRep = Array( _
"preferred stock", _
"Cash received from investment income", _
"Reinsurance payable", _
"Including", _
"(1)", _
"(2)", _
"common stock" _
)
strFolder = GetFolder
If strFolder = "" Then Exit Sub: Set RepObj = New DataObject
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
AddToRecentFiles:=False, Visible:=False)
With wdDoc
Set Rng = .Range
With Rng.Find
.ClearFormatting
With .Replacement
.ClearFormatting
With .Font
.Name = "Angsana New"
.Bold = True
.Color = wdColorRed
End With
End With
.Format = True
.Forward = True
.Wrap = wdFindContinue
For i = 0 To UBound(ArrFnd)
.Text = ArrFnd(i)
If Len(ArrRep(i)) < 255 Then
.Replacement.Text = ArrRep(i)
Else
RepObj.SetText ArrRep(i)
RepObj.PutInClipboard
.Replacement.Text = "^c"
End If
.Execute Replace:=wdReplaceAll
Next
End With
.Close SaveChanges:=True
End With
strFile = Dir()
Wend
Set wdDoc = Nothing: Set RepObj = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[nmkhan3010]

Hi

Thanks for replying but am having around 300+ find strings and 300+ replace strings and am getting errors as too many line continuations and getting expression error, can you please review once ...
Your help is highly appreicated ... thanks in advance ...



Sub UpdateDocuments()
'Note: This code requires a reference to the MS Forms 2.0 Object Library.
'See under Tools|References in the VBE. You may need to browse to and select C:\Windows\SysWOW64\FM20.DLL
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim Rng As Range, i As Long, ArrFnd(), ArrRep(), RepObj As DataObject
'Insert Find & Replace expressions here. The arrays must have the same # of entries


ArrFnd = Array( _
"######", _
"Current reporting period", _
"Same period in the previous year", _
"Increase or decrease in the reporting period compared with the same period last year" , _
"At the end of the reporting period", _
"Previous year end", _
"Increase or decrease at the end of the reporting period as compared to the end of the previous year (%)", _
"Operating income (yuan)", _
"Net profit attributable to shareholders of listed company (Yuan)", _
"Net profit attributable to shareholders of listing company after deducting of non-recurring gains and losses (Yuan)", _
"Net cash flow arising from operating activity (Yuan)", _
"Basic earnings per share (yuan/share)", _
)
ArrRep = Array( _
"######", _
"Current reporting period", _
"Same period in the previous year", _
"Increase or decrease in the reporting period compared with the same period last year", _
"At the end of the reporting period", _
"Previous year end", _
"Increase or decrease at the end of the reporting period as compared to the end of the previous year (%)", _
"Operating income (yuan)", _
"Net profit attributable to shareholders of listed company (Yuan)", _
"Net profit attributable to shareholders of listing company after deducting of non-recurring gains and losses (Yuan)", _
"Net cash flow arising from operating activity (Yuan)", _
)
strFolder = GetFolder
If strFolder = "" Then Exit Sub: Set RepObj = New DataObject
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
AddToRecentFiles:=False, Visible:=False)
With wdDoc
Set Rng = .Range
With Rng.find
.ClearFormatting
With .Replacement
.ClearFormatting
With .Font
.Name = "Angsana New"
.Bold = True
.Color = wdColorRed
End With
End With
.Format = True
.Forward = True
.Wrap = wdFindContinue
For i = 0 To UBound(ArrFnd)
.Text = ArrFnd(i)
If Len(ArrRep(i)) < 255 Then
.Replacement.Text = ArrRep(i)
Else
RepObj.SetText ArrRep(i)
RepObj.PutInClipboard
.Replacement.Text = "^c"
End If
.Execute Replace:=wdReplaceAll
Next
End With
.Close SaveChanges:=True
End With
strFile = Dir()
Wend
Set wdDoc = Nothing: Set RepObj = Nothing
Application.ScreenUpdating = True
End Sub


Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.PATH
Set oFolder = Nothing
End Function

[macropod]

The line breaks & continuations in the arrays aren't needed - they were supplied just to make the code easier to read. As for the expression errors, you don't even have the same number of Find & Replace expressions! You should also read what I said in my previous reply. A lot of your Find & Replace expressions could be shortened significantly through the use of wildcards. Finally, one wonders why you're trying to update 300+ strings via Find/Replace; that suggests the document probably needs re-writing from scratch.

[macropod]

Now cross-posted at: https://www.msofficeforums.com/word-vba/44767-find-replace.html
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq.php?faq=new_faq_item#faq_new_faq_item3
Asking the same question somewhere else isn't going to change the answer.