【コピペでOK】VBAでファイル名を一括変更！無料エクセルファイル付き！

ファイル名を一つずつ手作業で変更するのは面倒…
大量のファイルをリネームする作業に時間を取られてしまう…

ファイル名変更の効率化にも、VBAを使ったファイル名の一括変更マクロはとても役に立ちます。エクセルの機能であるVBAですが、ファイル名の効率化も可能です。

今回紹介するVBAは、フォルダ内のファイル名を一括で取得し、Excel上で変更を行うものです。リストを編集するだけで簡単にリネームできるので、手作業の手間を大幅に削減できます。それぞれの環境で使用できるようにコードも作成しているので、コピペするだけで使うことができます。

さらに初心者の方でも使えるように、エクセルファイル（無料）も用意しました。「VBAがよく分からない…」という方は、まずはダウンロードして試してみてください！

また、このブログではVBAを活用した業務効率化の方法を多数紹介しています。AI活用や自動化に興味がある方も、ぜひ他の記事をチェックしてみてください！

コピペで使えるファイル名変更VBA

エクセルVBAを使って、フォルダ内のファイル名を一括変更する方法を紹介します。今回は２種類のマクロを使用します。

①指定フォルダにあるファイル名をエクセルに書き込む
②ファイル名をエクセルで書いた名称に変更

使い方については後ほど、詳しく説明します。

①フォルダ内のファイル名を取得するVBA

「指定フォルダにあるファイル名をエクセルに書き込む」動作を行うVBAになります。

Sub CopyFileNames()
    Dim folderPath As String, fileName As String
    Dim ws As Worksheet, fileCell As Range
    
    Set ws = ThisWorkbook.Sheets(ActiveSheet.Name)
    ws.Cells.ClearContents
    ws.Range("A1").Select
    
    ws.Range("A2") = "対象フォルダ"
    ws.Range("A3:B3") = Array("変更前ファイル名", "変更後ファイル名")
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ws.Range("B2") = folderPath
    
    Set fileCell = ws.Range("A4")
    fileName = Dir(folderPath & "\*.*")
    
    Do While fileName <> ""
        fileCell.Value = fileName
        fileCell.Offset(0, 1).Value = fileName
        Set fileCell = fileCell.Offset(1, 0)
        fileName = Dir
    Loop
    
    MsgBox "変更したいファイル名をB列に記載してください。"
End Sub

②ファイル名を一括変更するVBA

「ファイル名をエクセルで書いた名称に変更」するVBAです。

Sub Change_name()
    Dim Result As VbMsgBoxResult
    Dim folderPath As String
    Dim fileCell As Range
    Dim ws As Worksheet
    
    Result = MsgBox("実行しますか？※処理後は戻せません", vbQuestion + vbYesNo, "確認")
    If Result <> vbYes Then Exit Sub
    
    Set ws = ThisWorkbook.Sheets(ActiveSheet.Name)
    folderPath = ws.Range("B2").Value
    
    For Each fileCell In ws.Range("A4:A" & ws.Cells(Rows.Count, "A").End(xlUp).Row)
        If Len(Dir(folderPath & "\" & fileCell.Value)) > 0 Then
            Name folderPath & "\" & fileCell.Value As folderPath & "\" & fileCell.Offset(0, 1).Value
        End If
    Next fileCell
    
    MsgBox "完了しました"
End Sub