私はある日、お客さんから「100ファイル近くのExcelファイルのファイル名を手作業で変更してくれ～」っていう依頼がありました。
具体的には「ファイル名_v1.2.xlsx」→「ファイル名_v1.3.xlsx」にしてくれ～～っていう内容です。
もちろん、ファイル数が少ないなら手でやったほうが速いと思いますが、
毎回、100ファイル近くを手作業でやるのにどれだけ時間がかかるか・・
しかし仕事をしていれば、少なからずそんなめんどくさい作業をすることがあると思います。
そこでこの度はExcel をつかってボタン一つでファイル名を一括置換するツールを作りました！
このツールは Excel Vba というプログラミングで作成されています。
この記事では「Excelでできる複数のファイル名を一括置換するツール」の使い方と作り方をご紹介します！
※ いつものようにつくったのも共有しときますので、よければどうぞ（ブック保護、シート保護はかかってます）。
※ 2022/06 機能追加しました！！50000ファイルまで置換可能！実行中画面の追加実装など！よければインストールどうぞ！
ファイル名を一括置換するツールの使い方
この「Excelでできる複数のファイル名を一括置換するツール」では以下の用に使います。
- 「検索ボタン」を押下しリネームしたいファイル一覧を取得します。
- ファイル名（置換後）列にファイル名を入力します。
- 「一括置換」ボタンでファイル名が変更できます。
「検索ボタン」を押下してリネームしたいファイル一覧を取得
まず「検索ボタン」を押下します。
すると下記のようなダイアログが表示されるので、ファイル名を変換したいファイルが配架されているフォルダを選択します。
このときファイル名が表示されませんが、問題ありません。
これにてB列とＣ列にファイル名とフォルダ名がそれぞれ出力されます。
ファイル名、フォルダ名を手入力しても問題ないですが、入力し間違えないようにする必要があります。
ファイル名（置換後）列にファイル名を入力
ファイル名（置換後）列にファイル名を入力します。
このツールではファイル名（置換前）→ファイル名（置換後）のようにファイルがリネーム（名前が変更）されます。
ファイル名（置換後）列に入力後、チェック列（E列）の値がOKになっていれば問題なしです。
なおチェック列がOK以外の値の場合はファイル名置換処理が実行されません。
チェック列がＯK以外のケース
チェック列では入力した値に誤りがあるかどうかをチェックします。
- ファイル名（置換後）列に重複している項目がないか
- ファイル名（置換前）列とファイル名（置換後）列で同じ値がないか
もし上記項目を満たした場合、下記画面のようにエラーメッセージが表示されるようになっています。
※ なおこのエラーメッセージはH列（非表示列）に入力していますので、H列は消さないようにお願いします！
「一括置換」ボタンでファイル名が変更
最後に「一括置換」ボタンを押下します。
すると下記のような処理完了メッセージが表示されます。
フォルダを確認しに行くとファイル名が一括置換されていることが確認できます！
以上がこのツールの使い方です。
続いてはこのツールの使い方を説明します。
ファイル名を一括置換するツールの作り方（Excel Vba）
ここからプログラミングの少し難しい話になります！
今回は「Excelでできる複数のファイル名を一括置換するツール」を作るうえで下記のような Excel VBA コードを作成しました。
このコードを Excel の開発タブ→ Visual Basic で表示されるエディタに貼り付ければOKです。
※ 開発タブがない場合は下記ページを参考にしてください。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 |
'================================================================================= ' 複数ファイル名を一括置換マクロ '================================================================================= 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 |
とりあえず上をコピーすればOKですが、それだとあまりに味気ないので説明します。
まずこのプログラムは以下のような機能があります。
- getFileList() ・・・ （リネームする）ファイル一覧を取得
- replaceFile() ・・・ ファイル名を一括置換
- reset() ・・・ 出力シートを初期化
今回のツールでの「（リネームする）ファイル一覧を取得」と「ファイル名を一括置換」する方法について説明します。
※ reset（）については割愛します。
Excel で（リネームする）ファイル一覧を取得・・・getFileList()
ファイル一覧を取得する方法は下記になります。
- ダイアログでフォルダ名取得
- 取得したフォルダ名をもとにフォルダ下のファイル一覧を取得
フォルダ名取得用のダイアログ画面は Application.FileDialog(msoFileDialogFolderPicker)で取得します。
戻り値として選択したフォルダ名（フルパス）で取得できます。
その取得したフォルダ名から Dir 関数でファイル一覧を取得し、シートに出力するだけです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
' ファイル一覧取得 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列）に値が実行されるまで実行します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
' ファイル名を一括置換 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 を返します。
- 置換前のファイル（B列）が存在するか
- 置換後のファイル（C列）が存在しないか
- チェック列（E列）がOKであるか
最後に
いかがでしたでしょうか？
この記事では「Excelでできる複数のファイル名を一括置換するツール」の使い方と作り方について解説しました。
このツールさえあればどれだけファイル数が多くてもファイル名の一括置換がラクラクできます！
この記事が読者の何かのお役に立てれば幸いです。
ではでは。
