The following two macros lets you rename files and folders recursively. Press Alt + F8 to open a list of macros, run macro "FindReplace".

  1. Type a text string you want to find, in the dialog box.
    rename files and folders
  2. In the next dialog box, type a text sting you want to replace it with.
    rename files and folders2
  3. Select a folder, click OK.
  4. The macro prompts you each time it finds a file name or folder with the text string you are looking for, if you want to rename it.
  5. Your options are: Yes, No and Cancel. Cancel exits the macro.
  6. The macro continues until all files and folders are processed.

The macro does NOT change the file extension name.

VBA macros

Sub FindReplace()
Dim myfolder
Dim Fnd As String, Rplc As String
Fnd = Application.InputBox(prompt:="Find string:", Title:="Rename files and folders", Type:=2)
Rplc = Application.InputBox(prompt:="Replace with:", Title:="Rename files and folders", Type:=2)
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    myfolder = .SelectedItems(1) & "\"
End With
Call Recursive(myfolder, Fnd, Rplc)
End Sub
Sub Recursive(FolderPath As Variant, Fnd As String, Rplc As String)
Dim Value As String, Folders() As String, Fname As String, Fext As String, Mtxt As String
Dim x As Integer
Dim Folder As Variant, a As Long
ReDim Folders(0)
If Right(FolderPath, 2) = "\\" Then Exit Sub
Value = Dir(FolderPath, &H1F)
Do Until Value = ""
    If Value = "." Or Value = ".." Then
    Else
        If GetAttr(FolderPath & Value) = 16 Or GetAttr(FolderPath & Value) = 48 Then
            On Error Resume Next
                Mtxt = "Rename folder " & Value & " to " & WorksheetFunction.Substitute(Value, Fnd, Rplc) & "?"
                x = MsgBox(Mtxt, vbYesNoCancel)
                If x = vbCancel Then Exit Sub
                If x = vbYes Then
                    Name FolderPath & Value As FolderPath & WorksheetFunction.Substitute(Value, Fnd, Rplc)
                End If
                Value = WorksheetFunction.Substitute(Value, Fnd, Rplc)
                If Err <> 0 Then
                    MsgBox "Error"
                    Exit Sub
                End If
            On Error GoTo 0
            Folders(UBound(Folders)) = Value
            ReDim Preserve Folders(UBound(Folders) + 1)
        Else
            On Error Resume Next
                Fext = Split(Value, ".")(UBound(Split(Value, ".")))
                Fname = Left(Value, Len(Value) - Len(Split(Value, ".")(UBound(Split(Value, ".")))) - 1)
                Fname = WorksheetFunction.Substitute(Fname, Fnd, Rplc)
                If Value <> (Fname & "." & Fext) Then
                    Mtxt = "Rename file " & Value & " to " & Fname & "." & Fext & "?"
                    x = MsgBox(Mtxt, vbYesNoCancel)
                    If x = vbCancel Then Exit Sub
                    If x = vbYes Then
                        Name FolderPath & Value As FolderPath & Fname & "." & Fext
                    End If
                End If
                If Err <> 0 Then
                    MsgBox "Error"
                    Exit Sub
                End If
            On Error GoTo 0
        End If
    End If
    Value = Dir
Loop
For Each Folder In Folders
    Call Recursive(FolderPath & Folder & "\", Fnd, Rplc)
Next Folder
End Sub

Download excel *.xlsm

Find and replace a character in file names folder names and subfolders.xlsm