私はある日、お客さんから「100ファイル近くのExcelファイルのファイル名を手作業で変更してくれ～」っていう依頼がありました。

具体的には「ファイル名_v1.2.xlsx」→「ファイル名_v1.3.xlsx」にしてくれ～～っていう内容です。

もちろん、ファイル数が少ないなら手でやったほうが速いと思いますが、

毎回、100ファイル近くを手作業でやるのにどれだけ時間がかかるか・・

しかし仕事をしていれば、少なからずそんなめんどくさい作業をすることがあると思います。

そこでこの度はExcel をつかってボタン一つでファイル名を一括置換するツールを作りました！

このツールは Excel Vba というプログラミングで作成されています。

この記事では「Excelでできる複数のファイル名を一括置換するツール」の使い方と作り方をご紹介します！

この「Excelでできる複数のファイル名を一括置換するツール」では以下の用に使います。

「検索ボタン」を押下してリネームしたいファイル一覧を取得

まず「検索ボタン」を押下します。

すると下記のようなダイアログが表示されるので、ファイル名を変換したいファイルが配架されているフォルダを選択します。

このときファイル名が表示されませんが、問題ありません。

これにてB列とＣ列にファイル名とフォルダ名がそれぞれ出力されます。

ファイル名、フォルダ名を手入力しても問題ないですが、入力し間違えないようにする必要があります。

ファイル名（置換後）列にファイル名を入力

ファイル名（置換後）列にファイル名を入力します。

このツールではファイル名（置換前）→ファイル名（置換後）のようにファイルがリネーム（名前が変更）されます。

ファイル名（置換後）列に入力後、チェック列（E列）の値がOKになっていれば問題なしです。

なおチェック列がOK以外の値の場合はファイル名置換処理が実行されません。

チェック列がＯK以外のケース

チェック列では入力した値に誤りがあるかどうかをチェックします。

もし上記項目を満たした場合、下記画面のようにエラーメッセージが表示されるようになっています。

※ なおこのエラーメッセージはH列（非表示列）に入力していますので、H列は消さないようにお願いします！

「一括置換」ボタンでファイル名が変更

最後に「一括置換」ボタンを押下します。

すると下記のような処理完了メッセージが表示されます。

フォルダを確認しに行くとファイル名が一括置換されていることが確認できます！

以上がこのツールの使い方です。

続いてはこのツールの使い方を説明します。

このコードを Excel の開発タブ→ Visual Basic で表示されるエディタに貼り付ければOKです。

※ 開発タブがない場合は下記ページを参考にしてください。

３分でできる！Excel VBA の開発を行うために必要な事前準備

2018.11.14

いまから 「vba を始めたいけれど、Excel で何をどうやってすればいいかわからない」という悩みはありませんか？ 本ページでは vba をどうやってはじめるか３分以内に終わる方法を解説します。 v...

'=================================================================================
' 複数ファイル名を一括置換マクロ
'=================================================================================

Const SEARCH_WORD = "\*.*"

Const CELL_PRINT_COL = 2
Const CELL_PRINT_ROW = 2
Const CELL_SEARCH_WORD = "B3"


' ファイル一覧取得
Sub getFileList()

    Application.ScreenUpdating = False

    Dim folderName
    Dim lastRow
    
    folderName = getFolderName()
    fileList = Dir(folderName & SEARCH_WORD)
    
    ' 最終行取得
    If Cells(CELL_PRINT_ROW + 1, CELL_PRINT_COL) = "" Then
        lastRow = CELL_PRINT_ROW + 1
    Else
        lastRow = Cells(CELL_PRINT_ROW, CELL_PRINT_COL).End(xlDown).Row
    End If
    
    Do While fileList <> ""
                
        Cells(lastRow, CELL_PRINT_COL) = folderName
        Cells(lastRow, CELL_PRINT_COL + 1) = fileList
        lastRow = lastRow + 1
        fileList = Dir()
        
    Loop
    
    Application.ScreenUpdating = True
    
End Sub


' ファイル名を一括置換
Sub replaceFile()

    Application.ScreenUpdating = False

    Dim folderName
    Dim beforeFile
    Dim afterFile
    Dim i
    
    On Error Resume Next
    i = CELL_PRINT_ROW + 1
    
    While Cells(i, CELL_PRINT_COL) <> ""
    
        folderName = Cells(i, CELL_PRINT_COL)
        beforeFile = folderName & "\" & Cells(i, CELL_PRINT_COL + 1)
        afterFile = folderName & "\" & Cells(i, CELL_PRINT_COL + 2)
        
        If check(beforeFile, afterFile) And Cells(i, CELL_PRINT_COL + 3) = "OK" Then
            Name beforeFile As afterFile
            Cells(i, CELL_PRINT_COL + 4) = "OK"
        Else
            Cells(i, CELL_PRINT_COL + 4) = "NG"
        End If
    
        i = i + 1
    
    Wend
    
    Application.ScreenUpdating = True
    
    MsgBox "ファイル名を一括置換しました！"
    
End Sub

' 初期化
Sub reset()

    Application.ScreenUpdating = False
    
    Range(Cells(CELL_PRINT_ROW + 1, CELL_PRINT_COL), Cells(Rows.Count, CELL_PRINT_COL + 2)).ClearContents
    Range(Cells(CELL_PRINT_ROW + 1, CELL_PRINT_COL + 4), Cells(Rows.Count, CELL_PRINT_COL + 4)).ClearContents
     
    Application.ScreenUpdating = True

End Sub


' 入力精査
Private Function check(ByVal beforeFile, ByVal afterFile) As Boolean

    If Dir(beforeFile) <> "" And Dir(afterFile) = "" Then
        check = True
    Else
        check = False
    End If
    
End Function


' ダイアログでフォルダ名取得
Private Function getFolderName()

    Dim folderPath As Variant
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            End
        End If
        folderPath = .SelectedItems(1)
    End With
    
    getFolderName = folderPath
  
End Function

今回のツールでの「（リネームする）ファイル一覧を取得」と「ファイル名を一括置換」する方法について説明します。

※ reset（）については割愛します。

Excel で（リネームする）ファイル一覧を取得・・・getFileList()

ファイル一覧を取得する方法は下記になります。

フォルダ名取得用のダイアログ画面は Application.FileDialog(msoFileDialogFolderPicker)で取得します。

戻り値として選択したフォルダ名（フルパス）で取得できます。

その取得したフォルダ名から Dir 関数でファイル一覧を取得し、シートに出力するだけです。

' ファイル一覧取得
Sub getFileList()

    Application.ScreenUpdating = False

    Dim folderName
    Dim lastRow
    
    folderName = getFolderName()
    fileList = Dir(folderName & SEARCH_WORD)
    
    ' 最終行取得
    If Cells(CELL_PRINT_ROW + 1, CELL_PRINT_COL) = "" Then
        lastRow = CELL_PRINT_ROW + 1
    Else
        lastRow = Cells(CELL_PRINT_ROW, CELL_PRINT_COL).End(xlDown).Row
    End If
    
    Do While fileList <> ""
                
        Cells(lastRow, CELL_PRINT_COL) = folderName
        Cells(lastRow, CELL_PRINT_COL + 1) = fileList
        lastRow = lastRow + 1
        fileList = Dir()
        
    Loop
    
    Application.ScreenUpdating = True
    
End Sub

' ダイアログでフォルダ名取得
Private Function getFolderName()

    Dim folderPath As Variant
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            End
        End If
        folderPath = .SelectedItems(1)
    End With
    
    getFolderName = folderPath
  
End Function

Excel でファイル名を一括置換・・・replaceFile()

シートに記述されている置換前後のファイル名を取得し、それらを Name 関数で取得します。

このリネーム（ファイル名を変更する）処理は一行ずつ実行されます。

このファイル名変更処理をシートの表の（B列）に値が実行されるまで実行します。

' ファイル名を一括置換
Sub replaceFile()

    Application.ScreenUpdating = False

    Dim folderName
    Dim beforeFile
    Dim afterFile
    Dim i
    
    On Error Resume Next
    i = CELL_PRINT_ROW + 1
    
    While Cells(i, CELL_PRINT_COL) <> ""
    
        folderName = Cells(i, CELL_PRINT_COL)
        beforeFile = folderName & "\" & Cells(i, CELL_PRINT_COL + 1)
        afterFile = folderName & "\" & Cells(i, CELL_PRINT_COL + 2)
        
        If check(beforeFile, afterFile) And Cells(i, CELL_PRINT_COL + 3) = "OK" Then
            Name beforeFile As afterFile
            Cells(i, CELL_PRINT_COL + 4) = "OK"
        Else
            Cells(i, CELL_PRINT_COL + 4) = "NG"
        End If
    
        i = i + 1
    
    Wend
    
    Application.ScreenUpdating = True
    
    MsgBox "ファイル名を一括置換しました！"
    
End Sub

' 入力精査
Private Function check(ByVal beforeFile, ByVal afterFile) As Boolean

    If Dir(beforeFile) <> "" And Dir(afterFile) = "" Then
        check = True
    Else
        check = False
    End If
    
End Function

また上記処理では入力したファイル名が正しいかどうかを精査する check 関数も実行しております。

この check関数は下記条件すべてを満たす場合に True、それ以外は False を返します。

このツールさえあればどれだけファイル数が多くてもファイル名の一括置換がラクラクできます！