Add a folder picker to a search and replace macro

Sub x_SearchAndReplace_MultipleFiles_Folders_Subfolders()

Dim FSO As Object
Dim ROOT As Object
Dim fldr As Object
    
strFolder = SelectFolder (“c:\”)
strFind = UserInput( "Find what:" )
strRepl = UserInput( "Replace with:" )

Set FSO = CreateObject("scripting.filesystemobject")
If Not FSO.folderexists(strFolder) Then
	MsgBox "Folder '" & strFolder & "' not found - Exiting routine", , "Error"
	Exit Sub
End If
Set ROOT = FSO.getfolder(strFolder & "\")
processFolder ROOT.path
For Each fldr In ROOT.subfolders
	processFolder fldr.path & "\"
Next    

End Sub



Sub processFolder(strFolder As String)
Dim strFile As String
Dim doc As Document
Dim rng As Word.Range
Dim fileSet As Object

    strFile = Dir$(strFolder & "*.docx")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & strFile)
        
        For Each rng In doc.StoryRanges
        
                    With rng.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        .Text = strFind
                        .Replacement.Text = strRepl
                        .Replacement.Font.Size = 9
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                Next rng
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub


Function SelectFolder( myStartFolder )
' This function opens a "Select Folder" dialog and will
' return the fully qualified path of the selected folder
'
' Argument:
'     myStartFolder    [string]    the root folder where you can start browsing;
'                                  if an empty string is used, browsing starts
'                                  on the local computer
'
' Returns:
' A string containing the fully qualified path of the selected folder
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com

    ' Standard housekeeping
    Dim objFolder, objItem, objShell
    
    ' Custom error handling
    On Error Resume Next
    SelectFolder = vbNull

    ' Create a dialog object
    Set objShell  = CreateObject( "Shell.Application" )
    Set objFolder = objShell.BrowseForFolder( 0, "Select Folder", 0, myStartFolder )

    ' Return the path of the selected folder
    If IsObject( objfolder ) Then SelectFolder = objFolder.Self.Path

    ' Standard housekeeping
    Set objFolder = Nothing
    Set objshell  = Nothing
    On Error Goto 0
End Function

Function UserInput( myPrompt )
' This function prompts the user for some input.
' When the script runs in CSCRIPT.EXE, StdIn is used,
' otherwise the VBScript InputBox( ) function is used.
' myPrompt is the the text used to prompt the user for input.
' The function returns the input typed either on StdIn or in InputBox( ).
' Written by Rob van der Woude
' http://www.robvanderwoude.com
' Check if the script runs in CSCRIPT.EXE
If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
   ' If so, use StdIn and StdOut
   WScript.StdOut.Write myPrompt & " "
   UserInput = WScript.StdIn.ReadLine
Else
   ' If not, use InputBox( )
   UserInput = InputBox( myPrompt )
End If
End Function

Select all Open in new window