複数のファイル名を一括取得するVBAと、
複数のファイル名を一括置換するVBAをご紹介します。
対象ファイル種別はエクセル・CSV・ワードなど何でも可能です。
目次
マクロ機能が有効なExcelブック「.xlsm」を作成
Excelブック「.xlsm」の作成方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】マクロ機能が有効なExcelブック「.xlsm」の作り方
コードを標準モジュールに貼り付け
標準モジュールの開き方が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】標準モジュールの開き方
標準モジュールを開いて、下記のコードを貼り付けて下さい。
コード
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 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 |
Sub main() ' 変数定義 Dim objFileDialog As Object 'FileDialog Dim strTitle As String 'タイトル Dim strPath As String 'フォルダパス Dim strInitialPath As String '初期フォルダパス Dim sh As Worksheet, flag As Boolean Dim rc As Integer For Each sh In Worksheets If sh.Name = "Sheet1" Then flag = True Next sh If flag = True Then 'シートを選択 Worksheets("Sheet1").Activate MsgBox "ファイル名を取得したい、フォルダを選択して下さい。" & Chr(13) & Chr(13) & "※シート「Sheet1」を上書きします。" & Chr(13) & "※上書きしたくない場合は、キャンセルをクリックして下さい。" & Chr(13) & "※実行後、この処理は戻せません。" ' フォルダ選択ダイアログの初期設定 'ダイアログタイトル strTitle = "ファイル名を取得したいフォルダを選択して下さい" 'ダイアログの初期パスをモジュール起動エクセルに設定 strInitialPath = ActiveWorkbook.Path ' フォルダ選択ダイアログ表示 Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker) With objFileDialog 'タイトル .Title = strTitle '初期フォルダパス .InitialFileName = strInitialPath If .Show = False Then 'キャンセル時 ' GoTo Exit_Function MsgBox "キャンセルされました。処理を終了します。" Worksheets("Sheet1").Activate Range("A1").Select End Else 'フォルダパス取得 strPath = .SelectedItems(1) End If End With '画面更新停止 Application.ScreenUpdating = False '確認ダイアログ停止 Application.DisplayAlerts = False ' 変数定義 Dim lastRow As Long '変数lastRowを整数とする '変数lastRowにA1セルから見た最下の行数を代入 lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 'セルA2からC列最終行までのセルをクリア ThisWorkbook.Worksheets("Sheet1").Range(Cells(2, "A"), Cells(lastRow, "F")).ClearContents Dim FSO As FileSystemObject '変数fsoをファイルやフォルダなどの専用入れ物とする '変数fsoをインスタンス化 Set FSO = New FileSystemObject Dim fl As Folder '変数flをフォルダとする 'フォルダを指定 Set fl = FSO.GetFolder(strPath) Worksheets("Sheet1").Range("A1").Value = "ファイル名(現在)" & vbCrLf & "編集不要" Worksheets("Sheet1").Range("B1").Value = "拡張子(現在)" & vbCrLf & "編集不要" Worksheets("Sheet1").Range("C1").Value = "ファイル名+拡張子(現在)" & vbCrLf & "編集不要" Worksheets("Sheet1").Range("D1").Value = "ファイル名(変更後)" & vbCrLf & "入力欄" Worksheets("Sheet1").Range("E1").Value = "拡張子(変更後)" & vbCrLf & "編集不要" Worksheets("Sheet1").Range("F1").Value = "ファイル名+拡張子(変更後)" & vbCrLf & "編集不要" Dim bname As Object Set bname = CreateObject("Scripting.FileSystemObject") Dim f As File '変数fをファイルとする Dim i As Long: i = 2 '変数iを整数とする、 変数iを2整数とする '書式設定 Columns("F:F").Select Selection.NumberFormatLocal = "G/標準" 'シートを選択 ActiveSheet.Name = "Sheet1" '書式設定 Columns("A:F").Select Selection.ColumnWidth = 19.7 Columns("A:F").EntireColumn.AutoFit Selection.NumberFormatLocal = "@" Columns(1).Interior.ColorIndex = 15 Columns(2).Interior.ColorIndex = 15 Columns(3).Interior.ColorIndex = 15 Columns(5).Interior.ColorIndex = 15 Columns(6).Interior.ColorIndex = 15 Worksheets("Sheet1").Range("A1:C1").Interior.ColorIndex = 17 Worksheets("Sheet1").Range("D1").Interior.ColorIndex = 46 Worksheets("Sheet1").Range("E1:F1").Interior.ColorIndex = 6 'フォルダ内のファイルを取得 For Each f In fl.Files 'セルCi(変数)の値に取得したフォルダ名を代入 ' Cells(i, 1).Value = f.Name Cells(i, 1).Value = bname.GetBaseName(f.Path) Cells(i, 2).Value = bname.GetExtensionName(f.Path) Cells(i, 3).Value = "=A" & i & "&" & """.""" & "&" & "B" & i Cells(i, 5).Value = bname.GetExtensionName(f.Path) Cells(i, 6).Value = "=D" & i & "&" & """.""" & "&" & "E" & i '変数iに1を加える i = i + 1 Next ActiveSheet.Name = "Sheet1" '書式設定 Columns("C:C").Select Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 1), TrailingMinusNumbers:=True '書式設定 Columns("F:F").Select Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _ :=Array(1, 1), TrailingMinusNumbers:=True '書式設定 Selection.NumberFormatLocal = "G/標準" Worksheets("Sheet1").Range("F1").Value = "ファイル名+拡張子(変更後)" & vbCrLf & "編集不要" Cells(1, 1).Select Set objFileDialog = Nothing Set FSO = Nothing Set fl = Nothing Set bname = Nothing '画面表示ON Application.ScreenUpdating = False MsgBox "完了しました。処理を終了します。" & Chr(13) & "「Sheet1」シートを確認して下さい。" Else MsgBox "「Sheet1」シートがありません。先に「Sheet1」シートを追加して下さい。" & Chr(13) & "処理を終了します。" End If '画面更新 停止解除 Application.ScreenUpdating = True End Sub Sub main2() ' 変数定義 Dim objFileDialog As Object 'FileDialog Dim strTitle As String 'タイトル Dim strPath As String 'フォルダパス Dim strInitialPath As String '初期フォルダパス Dim sh As Worksheet, flag As Boolean Dim rc As Integer For Each sh In Worksheets If sh.Name = "Sheet1" Then flag = True Next sh If flag = True Then 'シートを選択 Worksheets("Sheet1").Activate MsgBox "ファイル名を置換したい、フォルダを選択して下さい。" & Chr(13) & Chr(13) & "※ファイル名を上書きします。" & Chr(13) & "※上書きしたくない場合は、キャンセルをクリックして下さい。" & Chr(13) & "※実行後、この処理は戻せません。" ' フォルダ選択ダイアログの初期設定 'ダイアログタイトル strTitle = "ファイル名を置換したいフォルダを選択して下さい" 'ダイアログの初期パスをモジュール起動エクセルに設定 strInitialPath = ActiveWorkbook.Path ' フォルダ選択ダイアログ表示 Set objFileDialog = Application.FileDialog(msoFileDialogFolderPicker) With objFileDialog 'タイトル .Title = strTitle '初期フォルダパス .InitialFileName = strInitialPath If .Show = False Then 'キャンセル時 ' GoTo Exit_Function MsgBox "キャンセルされました。処理を終了します。" Worksheets("Sheet1").Activate Range("A1").Select End Else 'フォルダパス取得 strPath = .SelectedItems(1) End If End With '画面更新停止 Application.ScreenUpdating = False '確認ダイアログ停止 Application.DisplayAlerts = False '変数定義 '変数lastRowを整数とする Dim lastRow As Long '変数lastRowにA1セルから見た最下の行数を代入 lastRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row '変数fsoをファイルやフォルダなどの専用入れ物とする Dim FSO As FileSystemObject '変数fsoをインスタンス化 Set FSO = New FileSystemObject '変数flをフォルダとする Dim fl As Folder 'フォルダを指定 Set fl = FSO.GetFolder(strPath) '変数指定fileNameを文字列とする Dim fileName As String ' Dim bname As Object ' Set bname = CreateObject("Scripting.FileSystemObject") Dim f As File '変数fをファイルとする Dim i As Long: i = 2 '変数iを整数とする、 変数iを整数2とする 'フォルダ内のファイルを置換 On Error Resume Next For Each f In fl.Files fileName = f.Name ' ファイル名の取得 If fileName = Cells(i, 3).Value Then ' ファイル名を変更したいファイル f.Name = Cells(i, 6).Value ' ファイル名の変更 '変数iに1を加える i = i + 1 End If Next Cells(1, 1).Select Set objFileDialog = Nothing Set FSO = Nothing Set fl = Nothing ' Set bname = Nothing '画面表示ON Application.ScreenUpdating = False MsgBox "完了しました。処理を終了します。" & Chr(13) & "「Sheet1」シートを確認して下さい。" & Chr(13) & Chr(13) & "※ファイル名重複などエラーは無視して、ファイル名置換処理は実行されません。" Else MsgBox "「Sheet1」シートがありません。先に「Sheet1」シートを追加して下さい。" & Chr(13) & "処理を終了します。" End If '画面更新 停止解除 Application.ScreenUpdating = True End Sub |
Microsoft Scripting Runtimeを有効にする
Microsoft Scripting Runtimeを有効にする方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】Microsoft Scripting Runtimeを有効にする方法
マクロを実行
上記で作成したマクロファイル(ここでは「複数のファイル名を一括で取得、置換するエクセルVBA.xlsm」とファイル名を設定。)と、
マクロ実行テスト用のダミーデータとして、エクセルファイルを準備します。
ファイル名を一括取得・置換したいファイルをフォルダに格納する
フォルダを新規作成して、対象ファイルをフォルダに格納します。
※フォルダ名は任意です。例として「ファイル名を一括で取得、置換するテストフォルダ」と入力しています。
マクロを実行してファイル名を一括取得する
マクロファイルを開いて、「コンテンツの有効化」をクリックします。
※設定により、「コンテンツの有効化」は表示されない(クリック不要の)場合もあります。
「開発」タブをクリックします。
「マクロ」をクリックします。
「main」→「実行」をクリックします。
メッセージが表示されるので確認して「OK」をクリックします。
ファイル名を一括取得したいファイルが格納されているフォルダを選択→「OK」をクリックします。
メッセージが表示されるので確認して「OK」をクリックします。
マクロを実行したファイルのシートにファイル名の一覧が作成されます。
マクロを実行してファイル名を一括置換する
ファイル名一覧のD列に置換後のファイル名を入力します。
「開発」タブをクリックします。
「マクロ」をクリックします。
「main2」→「実行」をクリックします。
メッセージが表示されるので確認して「OK」をクリックします。
ファイル名を一括置換したいファイルが格納されているフォルダを選択→「OK」をクリックします。
メッセージが表示されるので確認して「OK」をクリックします。
フォルダ内のファイル名が置換されます。
完了です。