今回は前回の記事の「指定したフォルダのファイル一覧を取得する」で取得したファイル名を任意のファイル名に変換するコードを紹介します。
一括でファイル名を変更できるので、変更したいファイル数が多い時に重宝します。
30日間無料登録できる「Amazonプライム会員」に登録すれば、翌日に購入した商品が届くお急ぎ便・お届け日時指定便の指定ができるので、荷物をなるべく早く受け取りたい人にオススメ！
無料体験期間中もAmazonプライムビデオや1億曲以上聞き放題のAmazon Musicなど、すべてのプライム会員特典がセットになっています！
うめ
30日間以内に解約すれば費用は発生しません！
コード
コードはなるべくシンプルに作りたかったので、選択したボタン名によって処理を分岐するようにしています。
|
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 |
Sub FilenameControl() Dim Ws As Worksheet: Set Ws = Worksheets("ファイル一覧") Dim Cnt As Long: Cnt = 7 Dim Path As String: Path = Ws.Range("B3") '格納先 Dim Buf As String: Buf = Dir(Path & "\" & "*.xlsx") Dim MaxRow As Long: MaxRow = Ws.Cells(7, 2).End(xlDown).Row Dim Old_Name As String '変換前ファイル名 Dim New_Name As String '変換後ファイル名 'ボタンのテキストを取得 Dim Button_Text As String: Button_Text = Ws.Buttons(Application.Caller).Text '【ファイル名を取得】 If Button_Text = "ファイル名を取得" Then '前回結果をクリア If Ws.Cells(7, 2) <> "" Then Ws.Range(Cells(7, 2), Cells(MaxRow, 2)).Clear '変換前をクリア Ws.Range(Cells(7, 4), Cells(MaxRow, 4)).Clear '変換後をクリア End If 'ファイルがなくなるまで繰り返す Do While Buf <> "" Ws.Cells(Cnt, 2) = Buf Cnt = Cnt + 1 Buf = Dir() Loop MsgBox "読み込み終了！" '【ファイル名を変換】 ElseIf Button_Text = "ファイル名を変換" Then '最終行まで繰り返す For Cnt = 7 To MaxRow Old_Name = Path & "\" & Ws.Cells(Cnt, "B") '変換前 New_Name = Path & "\" & Ws.Cells(Cnt, "D") '変換後 '変換後に記載があったファイル名のみ変換 If New_Name <> Path & "\" Then Name Old_Name As New_Name End If Next Cnt MsgBox "ファイル名を変換しました！" End If End Sub |
今回は一つのマクロで処理を分岐させているので、どちらのボタンも「FilenameControl」を登録しています。
注意点
使い方
①対象フォルダの下の行にファイル一覧を取得したいフォルダのパスを設定
※サンプル用のデータとしてCドライブ直下にSampleフォルダを作成して、Excelを10ファイル格納しています。
②「ファイル名を取得」を選択すると変更前にSampleフォルダのファイル一覧が表示されます。
③変更後に変更したいファイル名を設定して「ファイル名を変換」を選択
設定した通りにファイル名が変更されます！
補足
変換したくないファイル名は空白のままでOKです。
変更後に入力があるファイル名だけが変わります。
