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

Open in new window

Andreas HermleTeam leaderAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NVITEnd-user supportCommented:
Try this. I added 2 functions: SelectFolder, and UserInput on lines 7, 8, 9.

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

Open in new window

Rgonzo1971Commented:
Hi,

pls try
Sub x_SearchAndReplace_MultipleFiles_Folders_Subfolders()
Dim FSO As Object
Dim ROOT As Object
Dim fldr As Object
Dim strFolder

    Set FSO = CreateObject("scripting.filesystemobject")
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strFolder
        If .Show <> -1 Then
            MsgBox "Folder not selected - Exiting routine", , "Error"
        Exit Sub
        End If
        strFolder = .SelectedItems(1)
    End With
    If Not FSO.folderexists(strFolder) Or strFolder = "" Then
        MsgBox "Folder '" & strFolder & "' not found - Exiting routine", , "Error"
        Exit Sub
    End If
    With Application.Dialogs(wdDialogEditReplace)
        On Error Resume Next
        .Show
        On Error GoTo 0
        .Update
        strFind = .Find
        strReplace = .Replace
    End With
    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 = strReplace
                        .Replacement.Font.Size = 9
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                Next rng
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub

Open in new window

Regards

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Andreas HermleTeam leaderAuthor Commented:
Dear both,

thank you very much for your great and professional support.

Dear NVIT:
looks awesome. It is a pity that line 100-105 does not work on my machine, but I am sure this has something to do that I run the macro on my business computer at my company.
If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" Then
   ' If so, use StdIn and StdOut
   WScript.StdOut.Write myPrompt & " "
   UserInput = WScript.StdIn.ReadLine
Else

Open in new window


I have to comment out all these lines, i.e. 100-105 for the macro to come up with the InputBoxes

The Input Boxes appear as desired, the strange thing is that whatever I enter as search and replace text, nothing is replaced. The files get opened and saved superfast, but no replacement action whatsoever. Any idea why?

Thank you and Regards, Andreas
Exploring ASP.NET Core: Fundamentals

Learn to build web apps and services, IoT apps, and mobile backends by covering the fundamentals of ASP.NET Core and  exploring the core foundations for app libraries.

Andreas HermleTeam leaderAuthor Commented:
Hi Rgonzo,

the folder picker works just fine, the search and replace dialog comes up but whatever I enter into the search and replace fields nothing gets updated. I am not quite sure whether this dialog field is working as part of a macro in the first place, since I am not able to confirm any settings with an OK button. I just am able to close it.

If I tweak your code and comment out line 23 till 30 and change line 54 and 55 accordingly, everything works fine.

Regards, Andreas
Rgonzo1971Commented:
to use the built-in replace you have to first either click Replace or replace all then Close

if you remember the normal behavior of the replace Dialog is to stay open as long as it isn't closed

Regards
NVITEnd-user supportCommented:
Andreas... Just confirming... Your folder contains .docx files, as shown in first post, line 26?
Andreas HermleTeam leaderAuthor Commented:
Dear both,

sorry for the delay in getting back to you.

Rgonzo: okay, will try it out and then let you know
NVIT: yes they are all docx-files
Andreas HermleTeam leaderAuthor Commented:
Dear both,

having heeded your comments, the things I said before, I regret, are still valid, i.e.

@ NVIT:
looks awesome. It is a pity that line 100-105 do not work on my machine, ie.
... I get the error message: 424 runtime error. The following line gets highlighted:
If UCase( Right( WScript.FullName, 12 ) ) = "\CSCRIPT.EXE" (line 100)

I have to comment out all these lines, i.e. 100-105 for the macro to come up with the InputBoxes

The Input Boxes appear as desired, the strange thing is that whatever I enter as search and replace text, nothing is replaced. The files get opened and saved superfast, but no replacement action whatsoever.


@Rgonzo: I heeded your advice, i.e. I clicked replace / replace all, and then closed the dialog field.

But then, the macro loops thru all the files, open and closes them, but no replacement action whatsoever is completed. Strange isn't it. Anyhow the Folder Picker works great and this is the most important part for me.

Regards, Andreas
Andreas HermleTeam leaderAuthor Commented:
Dear both,

I suggest splitting the points as I did. I tweaked both codes a little bit so now they work just fine.

Thank you very much for your great and professional help. I really appreciate it.

Regards, Andreas
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Word

From novice to tech pro — start learning today.