Microsoft Office Forums - View Single Post - [Solved] Find and Replace whole folder content

macropod · 03-01-2020, 08:29 PM

OK, aside from the issue that I very much doubt your original code came from the forum, you can't use 'Selection' objects when (as the macro in the link does) the document being opened for processed remains invisible. The consequence of using your code the way you've done is that only the document containing the code gets processed. A simple approach is to use:

Code:

Sub FindReplaceAllFilesInFolder()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName: strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      Call FnR(.Range)
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = 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

Sub FnR(Rng As Range)
Dim strFindText As String, strReplaceText As String, nSplitItem  As Long
strFindText = "northenn,westenn"
strReplaceText = "northern,western"
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .Wrap = wdFindContinue
  For nSplitItem = 0 To UBound(Split(strFindText, ","))
    .Text = Split(strFindText, ",")(nSplitItem)
    .Replacement.Text = Split(strReplaceText, ",")(nSplitItem)
    .Execute Replace:=wdReplaceAll
  Next
End With
End Sub