Consulting

Results 1 to 5 of 5

Thread: RUNTIME ERROR 5174

  1. #1

    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



    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

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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
    Last edited by macropod; 04-17-2020 at 03:09 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

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

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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.
    Last edited by macropod; 04-14-2020 at 05:47 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •