RUNTIME ERROR 5174

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

Code:

---

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

---

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.

Code:

---

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

---

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 ...

Code:

---

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

---

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.

Now cross-posted at: https://www.msofficeforums.com/word-...d-replace.html
Please read VBA Express' policy on Cross-Posting in Rule 3: http://www.vbaexpress.com/forum/faq...._new_faq_item3
Asking the same question somewhere else isn't going to change the answer.