Mass Find & Replace including subfolders

Question

I don't really know VBA but have had some success with manipulating code in the past. I'm getting stuck with this one, where I tried to mix 2 different ideas into one. What I want to do is a mass find & replace with pop-up boxes to (1) select or insert the path (that includes subfolders); (2) insert the "find text"; (3) insert the "replace text"; and (4) cycle through all .docx files in all subfolders.

I found this code to do what I want on a single folder, but can't figure out how to manipulate it to include subfolders:

Sub FindAndReplaceInFolder()
  Dim objDoc As Document
  Dim strFile As String
  Dim strFolder As String
  Dim strFindText As String
  Dim strReplaceText As String
 
  '  Pop up input boxes for user to enter folder path, the finding and replacing texts.
  strFolder = InputBox("Enter folder path here:")
  strFile = Dir(strFolder & "\" & "*.docx", vbNormal)
  strFindText = InputBox("Enter finding text here:")
  strReplaceText = InputBox("Enter replacing text here:")
 
  '  Open each file in the folder to search and replace texts. Save and close the file after the action.
  While strFile <> ""
    Set objDoc = Documents.Open(FileName:=strFolder & "\" & strFile)
    With objDoc
      With Selection
        .HomeKey Unit:=wdStory
        With Selection.Find
          .text = strFindText
          .Replacement.text = strReplaceText
          .Forward = True
          .Wrap = wdFindContinue
          .Format = False
          .MatchCase = False
          .MatchWholeWord = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
      End With
      objDoc.Save
      objDoc.Close
      strFile = Dir()
    End With
  Wend
End Sub

Thanks in advance!

Answer 1

«I need pop-up windows as described in my original post. I'm not familiar enough with this stuff to make changes» For example:

Option Explicit
Dim FSO As Object, oFolder As Object, StrFolds As String, StrFnd As String, StrRep As String
 
Sub Main()
Dim TopLevelFolder As String, TheFolders As Variant, aFolder As Variant, i As Long
StrFnd = InputBox("Enter finding text here:")
If StrFnd = "" Then Exit Sub
StrRep = InputBox("Enter replacing text here:")
TopLevelFolder = GetFolder
If TopLevelFolder = "" Then Exit Sub
StrFolds = vbCr & TopLevelFolder
If FSO Is Nothing Then
  Set FSO = CreateObject("Scripting.FileSystemObject")
End If
'Get the sub-folder structure
Set TheFolders = FSO.GetFolder(TopLevelFolder).SubFolders
For Each aFolder In TheFolders
  RecurseWriteFolderName (aFolder)
Next
'Process the documents in each folder
For i = 1 To UBound(Split(StrFolds, vbCr))
  Call UpdateDocuments(CStr(Split(StrFolds, vbCr)(i)))
Next
End Sub
 
 
Sub RecurseWriteFolderName(aFolder)
Dim SubFolders As Variant, SubFolder As Variant
Set SubFolders = FSO.GetFolder(aFolder).SubFolders
StrFolds = StrFolds & vbCr & CStr(aFolder)
On Error Resume Next
For Each SubFolder In SubFolders
  RecurseWriteFolderName (SubFolder)
Next
End Sub


Sub UpdateDocuments(oFolder As String)
Application.ScreenUpdating = False
Dim strInFolder As String, strFile As String, wdDoc As Document
strInFolder = oFolder
strFile = Dir(strInFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strInFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Text = StrFnd
      .Replacement.Text = StrRep
      .Execute Replace:=wdReplaceAll
    End With
    'Save and close the document
    .Close SaveChanges:=True
  End With
  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

As coded, the macro will process .doc, .docx, and .docm files. To limit it to .docx files, change the .doc reference to .docx.