Excel VBAでファイル名を一括変更する方法

Excel VBAを使用してファイル名を一括変更するマクロの設定と使用方法について解説します。このマクロは、指定された範囲に入力された変更前後のファイル名に基づいて、ファイル名を自動的に変更します。

準備1：現状のファイル名を取得する
準備2：変更後のファイル名を設定する
VBAマクロを「標準モジュール」へセットする手順
マクロセット後の使用方法

準備1：現状のファイル名を取得する

この記事で紹介するファイル名の一括変更を実行する前に、対象ファイルのリストを作成してください。ファイル名取得のマクロは下記のページで紹介しています。

Excel VBAを使って指定ディレクトリのファイル一覧を取得する方法この記事では、Excel VBAを使用して指定したディレクトリ内のファイル一覧を取得し、Excelシートに書き出す方法について紹介します。このマクロはサブディレクトリ内の...

上記のマクロではディレクトリ名とファイル名が離れていますので「\」を区切り文字として連結しておきましょう。TEXTJOIN関数を用いれば以下のような式で連結が可能です。

=TEXTJOIN("\",TRUE,A1:B1)

準備2：変更後のファイル名を設定する

元のパス付ファイル名と、変更後のファイル名を対にして入力しておきましょう。セット後はマクロを登録します。

VBAマクロを「標準モジュール」へセットする手順

Excelを開き、Alt + F11キーを押してVBAエディタを開きます。
VBAエディタが開いたら、メニューから「挿入」→「標準モジュール」を選択します。
新しいモジュールが挿入されたら、以下のコードをコピーして貼り付けます。

Sub BatchRenameFiles()
    Dim ws As Worksheet
    Dim rngBefore As Range, rngAfter As Range
    Dim fileCount As Long, i As Long
    Dim oldFileName As String, newFileName As String
    Dim oldFilePath As String, newFilePath As String
    Dim oldDir As String, newDir As String
    Dim successCount As Long

    ' ワークシートを設定
    Set ws = ThisWorkbook.Sheets(1) ' 必要に応じてシート番号や名前を変更してください

    ' 変更前のファイル名が入力されている範囲を選択
    On Error Resume Next
    Set rngBefore = Application.InputBox("変更前のファイル名が入力されている範囲を選択してください", Type:=8)
    On Error GoTo 0

    ' 変更前のファイル名の範囲が選択されなかった場合、処理をキャンセル
    If rngBefore Is Nothing Then
        MsgBox "変更前のファイル名の範囲が選択されませんでした。処理をキャンセルします。", vbExclamation
        Exit Sub
    End If

    ' 変更後のファイル名が入力されている範囲を選択
    On Error Resume Next
    Set rngAfter = Application.InputBox("変更後のファイル名が入力されている範囲を選択してください", Type:=8)
    On Error GoTo 0

    ' 変更後のファイル名の範囲が選択されなかった場合、処理をキャンセル
    If rngAfter Is Nothing Then
        MsgBox "変更後のファイル名の範囲が選択されませんでした。処理をキャンセルします。", vbExclamation
        Exit Sub
    End If

    ' 変更前後の範囲のサイズを比較し、ファイル名変更処理
    fileCount = Application.Min(rngBefore.Cells.Count, rngAfter.Cells.Count)
    successCount = 0
    
    For i = 1 To fileCount
        oldFileName = rngBefore.Cells(i, 1).Value
        newFileName = rngAfter.Cells(i, 1).Value

        ' 新しいファイル名が無効または空白の場合はスキップ
        If Trim(newFileName) = "" Or InStr(newFileName, "/") > 0 Or InStr(newFileName, "\") > 0 Or InStr(newFileName, ":") > 0 Or InStr(newFileName, "*") > 0 Or InStr(newFileName, "?") > 0 Or InStr(newFileName, """") > 0 Or InStr(newFileName, "<") > 0 Or InStr(newFileName, ">") > 0 Or InStr(newFileName, "|") > 0 Then
            GoTo NextIteration
        End If

        ' 変更前と変更後のファイル名が同じ場合はスキップ
        If oldFileName = Left(oldFileName, InStrRev(oldFileName, "\") - 1) & "\" & newFileName Then
            GoTo NextIteration
        End If

        ' ファイルが存在するかチェック
        If Dir(oldFileName) <> "" Then
            ' 変更前のファイルパスからディレクトリを取得
            oldDir = Left(oldFileName, InStrRev(oldFileName, "\"))
            
            ' 変更後のファイル名にディレクトリ名が含まれているか確認
            If InStr(newFileName, "\") > 0 Then
                newFilePath = newFileName
            Else
                newFilePath = oldDir & newFileName
            End If
            
            ' 変更後のファイルパスからディレクトリを取得
            newDir = Left(newFilePath, InStrRev(newFilePath, "\"))
            
            ' ディレクトリ名が異なる場合、処理を中断
            If oldDir <> newDir Then
                MsgBox "変更前と変更後のディレクトリが異なります: " & vbCrLf & oldFileName & vbCrLf & newFilePath, vbCritical
                Exit Sub
            End If

            ' ファイル名を変更
            On Error GoTo ErrorHandler
            Name oldFileName As newFilePath
            On Error GoTo 0
            
            ' 成功した場合、カウントを増加
            successCount = successCount + 1
        End If

NextIteration:
    Next i

    MsgBox successCount & " 件のファイル名を変更しました。", vbInformation
    Exit Sub

ErrorHandler:
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical
    Exit Sub
End Sub