Excel VBAでフォルダー内の全ファイル名を一括置換

フォルダー内の大量のファイル名を変更する必要があり
作成しました。
Excel VBAでフォルダー内の全ファイル名を一括置換します
※サブフォルダーも含まれます。

実行方法

・E１に「フォルダーパス」を入力する
・E2に置換前の文字列を入力する
・E3に置換後の文字列を入力する

・VBAエディタを起動します（Alt + F11キー）。

・「挿入」メニューから「モジュール」を選択して、新しいモジュールを作成します。

・下記のコードをモジュールウィンドウに貼り付けます。

・マクロを実行します（Alt + F8キー、作成したマクロを選択して「実行」）。

Sub ReplaceFileNamesInFolderAndSubfolders()
    Dim folderPath As String
    Dim stringToFind As String
    Dim stringToReplace As String
    Dim fso As Object
    Dim folder As Object
    Dim subFolder As Object
    Dim file As Object
    
    ' セルの値を取得
    folderPath = ThisWorkbook.Sheets(1).Range("E1").Value
    stringToFind = ThisWorkbook.Sheets(1).Range("E2").Value
    stringToReplace = ThisWorkbook.Sheets(1).Range("E3").Value
    
    ' FileSystemObjectの作成
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 指定されたフォルダが存在するか確認
    If fso.FolderExists(folderPath) Then
        Set folder = fso.GetFolder(folderPath)
        ReplaceFileNames folder, stringToFind, stringToReplace, fso
    Else
        MsgBox "指定されたフォルダーが存在しません。", vbExclamation
    End If
End Sub

Sub ReplaceFileNames(folder As Object, stringToFind As String, stringToReplace As String, fso As Object)
    Dim subFolder As Object
    Dim file As Object
    Dim newName As String
    
    ' フォルダ内のファイル名を置換
    For Each file In folder.Files
        If InStr(file.Name, stringToFind) > 0 Then
            newName = Replace(file.Name, stringToFind, stringToReplace)
            file.Name = newName
        End If
    Next file
    
    ' サブフォルダーも再帰的に処理
    For Each subFolder In folder.SubFolders
        ReplaceFileNames subFolder, stringToFind, stringToReplace, fso
    Next subFolder
End Sub