【Excel VBA】選択したファイル名の一部を変更するマクロの事例

Excel VBAで、選択した複数のファイル名の一部を一括で置換するマクロの事例です。

想定される用途としては、顧客ごとのフォルダにテンプレートをもとにした複数のファイルを作成する必要があるような場面です。たとえば、テンプレートファイル名に含まれる「社名」や「案件名」などを、顧客ごとに一括で変更することで、作業の効率化が図れます。

内容：

アウトプットイメージ
VBAサンプル
- 補足説明

なお、確認のExcelは「Microsoft® Excel® for Microsoft 365 MSO」（バージョン2506）です。

アウトプットイメージ

この事例では、ファイル名の一部にある”ZZZZZ”の箇所を指定した名前に一括置換します。

ファイル名の一部にある”ZZZZZ”の箇所を一括置換しています — 選択したファイル名の一部を変更するマクロのアウトプットイメージ

なお、置換後の名前は入力フォームで設定し、一括置換する事例です。

VBAサンプル

VBAのサンプルは次のとおりです。

Sub 選択したファイル名の変更()
    Dim 置換前文字 As String
    Dim 置換後の文字 As String
    Dim ファイルパス As Variant
    Dim 新ファイル名 As String
    Dim フォルダパス As String

    ' 置換文字の入力 '
    置換前文字 = "ZZZZZ" '必要に応じてInputBoxなどに変更'
    置換後の文字 = InputBox("置換後の文字列を入力してください")
    If 置換前文字 = "" Or 置換後の文字 = "" Then
        MsgBox "文字列が未入力のため、処理を中止します。", vbExclamation
        Exit Sub
    End If

    ' ファイル選択 '
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "ファイルを選択してください"
        .InitialFileName = ThisWorkbook.Path & "\"
        .Filters.Clear
        .Filters.Add "すべてのファイル", "*.*"
        If .Show <> -1 Then Exit Sub

        ' ファイル名の置換処理（ファイル名だけの処理が必要な場合に備えて分けた処理)'
        For Each ファイルパス In .SelectedItems
            フォルダパス = Left(ファイルパス, InStrRev(ファイルパス, "\"))
            新ファイル名 = Replace(Mid(ファイルパス, InStrRev(ファイルパス, "\") + 1), 置換前文字, 置換後の文字)

            If 新ファイル名 <> Mid(ファイルパス, InStrRev(ファイルパス, "\") + 1) Then
                Name ファイルパス As フォルダパス & 新ファイル名
            End If
        Next
    End With

    MsgBox "ファイル名の変更が完了しました。"
End Sub