Microsoft Office Forums - View Single Post - [Solved] Static Folder Locations to Automate a Find and Replace using Word VBA

Guessed · 01-28-2020, 03:15 PM

Look carefully at this code and step through it line by line to work out what each line is doing. Your code sample shows a lot of useless activities going on. There are some key differences in this code when compared to yours and those differences can be important.

Code:

Sub bfMassReplaceLoopTest()
  Dim wDoc As Word.Document, i As Integer
  Dim fso As Object, mySource As Object, file As Object
  
  Application.ScreenUpdating = False
  On Error Resume Next
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set mySource = fso.GetFolder("C:\Users\rmoyar\Desktop\TestEnvironment\Macro Testing\Test 1")
  
  For Each file In mySource.Files       'loop through the directory
    If file.Name Like "*.doc*" And InStr(1, file.Name, "$") = 0 Then '$ is temp file mask
      i = i + 1
      Debug.Print i, file.Name
      Set wDoc = Documents.Open(FileName:=file, ConfirmConversions:=False, ReadOnly:=False, _
                AddToRecentFiles:=False, Visible:=True, Format:=wdOpenFormatAuto, XMLTransform:="")
      With wDoc.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = " 120 BF" 'Find What
        .Replacement.Text = " 125 BF" 'Replace With
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
      End With
      wDoc.Close SaveChanges:=True
    End If
  Next file
  Application.ScreenUpdating = True
  MsgBox "Task Complete, please check files", vbInformation
End Sub

Note that this code is only working on a single folder. You mentioned wanting this to work over ~100 folders but you need to make sure one folder is being done correctly first.