まえがき
今回はフォルダ内のファイル名を抽出するマクロと、ファイル名を変更するマクロについて解説します。
具体的な使い方の例として、特定のフォルダからファイル名を取り出して、Excel上で加工した名前に変更するマクロを作成します。
作成したマクロは無償提供しますので、こちらからダウンロードしてご利用ください。
本マクロの内容も開示しますので、改造、無断配布も自由にして頂いて構いません。
ニャント、タダ!!!
ファイル名の抽出
ファイル名を抽出するためにはDir関数を使います。
| ファイル名 = Dir(フォルダパス\) |
ファイルが複数ある場合は以下コマンドで次のファイル名を取得します。
| ファイル名 = Dir() |
次のファイルが無い場合はファイル名が空(“”)となるので、Do While ファイル名 <> “”で、繰り返し処理を行う事ですべてのファイル名を取り出す事ができます。
ここから具体例を記載します。
ファイル名を取得するフォルダ(dPath)をCells(3, 2)に記載させるテンプレートだとします。
取得したファイル名をbuffとします。
| dPath = Cells(3, 2) |
| buff = Dir(dPath & “\”) ‘対象ディレクトリにdirコマンドを実施 |
| Do While buff <> “” |
| i = i + 1 ‘iは取得したファイル名を格納するセル行を指定する数 |
| Cells(i, 1) = buff |
| buff = Dir() ‘dirした次の結果をbuffに代入 |
| Loop |
2行目で対象ディレクトリからファイル名を取得します。
3行目、最後のファイル名を取得して対象ファイルが無くなると空（””）を返すので、それで終了させます。
4～5行目で取得したファイル名を、1列目に格納します。例では記載されていませんが、初期値としてi=20として、21行目から記載させる作りとしています。
buff = Dir() で次のファイル名を取得し、LoopでDo While行に戻ります。
ファイル名の変更
VBAでファイル名を変更するには、以下のコマンドを実行します。
| Name フォルダパス\元のファイル名 As フォルダパス\変更後のファイル名 |
ファイル名を変更する時にエラーとなる原因は3つあります。
- 変更元のファイル名が存在しない
- 変更元と変更先のファイル名が同じ
- 変更後のファイル名が既にフォルダに存在している
エラーの原因を条件分岐で除外した場合の具体例を示します。
変更元のファイル名が存在しない
| Case Dir(フォルダパス\元のファイル名) = “” |
Dir関数を使ってファイルの存在確認を行っています。ファイルが存在しない場合は空(“”）となるため、この条件が成立すれば、元のファイルが無い事が分かります。
変更元と変更先のファイル名が同じ
フォーマットのExcelはこのようになっています。
変更元のファイル名を指定するセルは１列目で、変更後のファイル名を指定するセルは２列目です。i3は対象のセルの行数を表しています。
| Case Cells(i3, 1) = Cells(i3, 2) |
単純に変更前と変更後の記載が同じであれば、それを除外するだけで大丈夫です。
変更後のファイル名が既にフォルダに存在している
変更後のファイル名がフォルダ内にある場合も、その名前に変更する事ができないので、Dir関数で存在確認します。ファイルが存在する場合は空(“”）とならないので以下条件が成立すれば、既に同じファイル名のものが存在する事が分かります。
| Case Dir(フォルダパス\変更後のファイル名) <> “” |
具体例
上の条件を踏まえて、Select Caseの条件文でエラーを除外するとこのようになります。
| Select Case True |
| Case Dir(fPath & Cells(i3, 1)) = “” |
| Cells(i3, 3) = “変更元のファイル名が存在しません” |
| Case Cells(i3, 1) = Cells(i3, 2) |
| Cells(i3, 3) = “同名” |
| Case Dir(fPath & Cells(i3, 2)) <> “” |
| Cells(i3, 3) = “変更後のファイル名が既に存在します” |
| Case Else |
| Name fPath & Cells(i3, 1) As fPath & Cells(i3, 2) |
| End Select |
すべてのエラー条件に当てはまらない場合は、Case Elseで名前変更を実行します。
提供したマクロの内容（参考）
ここからはマクロの内容を張り付けています。細かい解説は無いですが、重要なポイントは上で説明しています。８年前(2016/3/11)に作成したものなので、拙い部分や改善点はあると思いますが、必要に応じて修正してください。
ファイル名抽出
| Private Sub CommandButton1_Click() |
| ‘対象ディレクトリから.txtのファイル名を抽出 |
| Dim dPath As String ‘指定されたパスを格納するのに使用 |
| Dim buff As String ‘対象ディレクトリ内のファイル名を格納するのに使用 |
| lRow = Cells(Rows.Count, 1).End(xlUp).Row |
| If lRow < 21 Then |
| lRow = 21 |
| End If |
| Range(Cells(21, 1), Cells(lRow, 2)).Clear |
| lRow2 = Cells(Rows.Count, 3).End(xlUp).Row |
| If lRow2 < 21 Then |
| lRow2 = 21 |
| End If |
| Range(Cells(21, 3), Cells(lRow2, 3)).Clear |
| i = 20 |
| dPath = Cells(3, 2) |
| buff = Dir(dPath & “\”) ‘対象ディレクトリにdirコマンドを実施 |
| Do While buff <> “” |
| i = i + 1 |
| Cells(i, 1) = buff |
| buff = Dir() ‘dirした次の結果をbuffに代入 |
| Loop |
| End Sub |
ファイル名変更
| Private Sub CommandButton2_Click() |
| lRow = Cells(Rows.Count, 1).End(xlUp).Row |
| fPath = Cells(3, 2) & “\” |
| For i2 = 21 To lRow |
| If Cells(i2, 2) = “” Then |
| MsgBox (“変更後のファイル名を記載して下さい”): Exit Sub |
| End If |
| Next i2 |
| lRow2 = Cells(Rows.Count, 3).End(xlUp).Row |
| If lRow2 < 21 Then |
| lRow2 = 21 |
| End If |
| Range(Cells(21, 3), Cells(lRow2, 3)).Clear |
| For i3 = 21 To lRow |
| Select Case True |
| Case Dir(fPath & Cells(i3, 1)) = “” |
| Cells(i3, 3) = “変更元のファイル名が存在しません” |
| Case Cells(i3, 1) = Cells(i3, 2) |
| Cells(i3, 3) = “同名” |
| Case Dir(fPath & Cells(i3, 2)) <> “” |
| Cells(i3, 3) = “変更後のファイル名が既に存在します” |
| Case Else |
| Name fPath & Cells(i3, 1) As fPath & Cells(i3, 2) |
| End Select |
| Next i3 |
| MsgBox (“ファイル名を変更しました”) |
| End Sub |
拡張子を変更する
変更後のファイル名の拡張子を一括変更するためにつくった機能です。B列のファイル名が、Cells(4,2)に入力した拡張子に変更されます。
| Private Sub CommandButton3_Click() |
| lRow = Cells(Rows.Count, 1).End(xlUp).Row |
| For i2 = 21 To lRow |
| If Cells(i2, 1) <> “” Then |
| tmp1 = Split(Cells(i2, 1), “.”) |
| tmp2 = tmp1(0) |
| For i3 = 1 To UBound(tmp1) – 1 |
| tmp2 = tmp2 + “.” + tmp1(i3) |
| Next i3 |
| Cells(i2, 2) = tmp2 & “.” & Cells(4, 2) |
| End If |
| Next i2 |
| End Sub |
番号追加準備
変更後のファイル名の頭に連番を付ける機能です。0表示有にすると、ファイル数に合わせて10ファイル以上であれば01にしたり、100ファイル以上であれば001とすることで、フォルダ上でも正しく順番に並べる事が出来ます。
| Private Sub CommandButton4_Click() |
| lRow = Cells(Rows.Count, 2).End(xlUp).Row |
| If Cells(5, 2) = “0表示無し” Then |
| For i1 = 21 To lRow |
| Cells(i1, 2) = i1 – 20 & “_” & Cells(i1, 2) |
| Next i1 |
| Else |
| maxnum = Len(lRow – 20) |
| For i1 = 21 To lRow |
| numlen = Len(i1 – 20) |
| n1 = maxnum – numlen |
| numstr = i1 – 20 |
| If n1 > 0 Then |
| For i4 = 1 To n1 |
| numstr = “0” & numstr |
| Next i4 |
| End If |
| Cells(i1, 2) = numstr & “_” & Cells(i1, 2) |
| Next i1 |
| End If |
| End Sub |
あとがき
今回はフォルダ内のファイル名を取得する方法と、ファイル名を変更する方法を組み合わせて、ファイル名一括変更ツールを作成したものを紹介させて頂きました。
8年前に作成したものですので、自身でも忘れている部分も多く、解説を省略した部分もありますが、思い出したら、後ほど解説は追記したいと思います。備忘のためにも、このブログを通じて、自身のノウハウを残していければ良いと思っておりますので、今後も応援よろしくお願いします。
