Add a folder picker to a search and replace macro

Dear Experts:

below macro does search and replace operations in nested subfolders.

The 'master folder' is hard coded on line 6. I wonder whether the macro can be tweaked to accommodate the following two requirements.

1. A folder picker is to let the user choose the 'master folder'
2. The built in Search and Replace Dialog is to appear where the user can enter his/her search and replace criteria.

Help is much appreciated.

Thank you very much in advance.

Regards, Andreas

I wonder whether somebody could

Sub x_SearchAndReplace_MultipleFiles_Folders_Subfolders()
Dim FSO As Object
Dim ROOT As Object
Dim fldr As Object
    
    Const strFolder = "C:\Trial\"
    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 = "15.500"
                        .Replacement.Text = "19.500"
                        .Replacement.Font.Size = 9
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                Next rng
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub

Select all Open in new window