指定したフォルダのファイル名を取得し、そのファイル名を一括で変換（Excel VBA）

【本日のミッション】

Excel VBAを使用して、指定したフォルダのファイル名を取得し、そのファイル名を任意の名前に一括で変換せよ。

1 ミッションの概要
2 ファイルの準備とプロシージャ
3 マクロの実行
4 Dir関数
5 ファイルチェック
6 Nameステートメント
7 【参考】

ミッションの概要

業務の中で、ファイル名を規則に則った名前に変えないといけない時ってありますよね。

でも、そのファイルが多すぎて・・・手作業では無理・・・。

なんとか、簡単に変換できないものか・・・というのが今回のミッションです。

せっかくなので、Excelのことを知らない方にも使っていただけるような、何度も誰でも使えるツールを作っちゃいましょう(#^.^#)

ファイルの準備とプロシージャ

Excelマクロ有効ブック（.xlsm）のファイルを新規作成します。

そのファイルのシートに下記の通り、フォルダのパスを入力するセル（A2）、取得したファイル名を書き出すセル（7行目1列目～）、そのファイル名から変更するファイル名を指定するセル（7行目3列目～）を準備します。

Alt＋F11でVsual Basic Editerを起動します。

［挿入］－［標準モジュール］で新規モジュールを作成し、下記の通りコードを記入します。

Sub ファイル名取得()
    '【変数】
    'ファイル関連
    Dim pt As String    'フォルダパス
    Dim fn As String    'ファイル名
    
    '行列関連
    Dim t_row As Long   'ファイル名取得行
    
    '■変数セット
    pt = Range("A2")    'フォルダパス
    t_row = 7           'ファイル名取得行
    
    '■フォルダパス指定の確認
    If pt = "" Then
        MsgBox "フォルダパスをセルA2に入力してください。"
        Exit Sub
    End If
    
    '■フォルダパスに「\」が付いてなかったら付ける
    If Right(pt, 1) <> "\" Then
        pt = pt & "\"
    End If

    '■指定したフォルダパスが存在するか確認
    If Dir(pt, vbDirectory) = "" Then
        MsgBox "ご指定のフォルダパスは存在しません。"
        Exit Sub
    End If
    
    '■前回処理データの削除
    Rows(t_row & ":" & Cells.Rows.Count).Clear

    '■指定フォルダパス内のファイル名の取得が終わるまでLoop
    fn = Dir(pt & "*.*") '指定フォルダパス内の1個目のファイル名を取得
    Do While fn <> ""
        Cells(t_row, 1) = fn     'A列にファイル名取得
        t_row = t_row + 1        'ファイル名取得行+1
        fn = Dir()               '指定フォルダパス内の次のファイル名を取得
    Loop
    
    MsgBox "ファイルの取得が完了しました。" & Chr(10) & _
        "C列に変更後のファイル名を入力してください。" & Chr(10) & _
        "C列が空欄の場合は、ファイル名は変更されません。"
End Sub

Sub ファイル名変更()

    '【変数】
    'ファイル関連
    Dim pt As String        'フォルダパス
    Dim old_nm As String    '変更前ファイル名
    Dim new_nm As String    '変更後ファイル名
    
    '行列関連
    Dim s_row As Long       '処理開始行
    Dim t_row As Long       '処理対象行
    Dim e_row As Long       'A列 最終行
    
    '■変数セット
    pt = Range("A2")    'フォルダパス
    s_row = 7           '処理開始行
    e_row = Cells(Cells.Rows.Count, 1).End(xlUp).Row    'A列 最終行
    
    '■フォルダパス指定の確認
    If pt = "" Then
        MsgBox "フォルダパスをセルA2に入力してください。"
        Exit Sub
    End If
    
    '■変更前ファイル名有無の確認
    If e_row = 6 Then
        MsgBox "先に＜ファイル名取得＞処理を行ってください。"
        Exit Sub
    End If
    
    '■フォルダパスに「\」が付いてなかったら付ける
    If Right(pt, 1) <> "\" Then
        pt = pt & "\"
    End If

    '■指定したフォルダパスが存在するか確認
    If Dir(pt, vbDirectory) = "" Then
        MsgBox "ご指定のフォルダパスは存在しません。"
        Exit Sub
    End If
    
    '■前回結果データの削除
    Range("D7:D" & Cells.Rows.Count).Clear
    
    '■変更前ファイル名を順に処理
    For t_row = s_row To e_row
        old_nm = Cells(t_row, 1)    '変更前ファイル名
        new_nm = Cells(t_row, 3)    '変更後ファイル名
        
        '■ファイルチェック
        '□変更後ファイル名に使用できない文字列が含まれている場合
        If InStr(new_nm, "\") > 0 Or InStr(new_nm, "/") > 0 Or _
            InStr(new_nm, ":") > 0 Or InStr(new_nm, "*") > 0 Or _
            InStr(new_nm, "?") > 0 Or InStr(new_nm, """") > 0 Or _
            InStr(new_nm, "<") > 0 Or InStr(new_nm, ">") > 0 Or _
            InStr(new_nm, "|") > 0 Then

            Cells(t_row, 4) = "変更後ファイル名にファイル名に使用できない文字列が含まれています。"
        
        '□変更前ファイル名が空欄の場合
        ElseIf old_nm = "" Then
            Cells(t_row, 4) = "変更前ファイル名が空欄です。"
        
        '□変更後ファイル名が空欄の場合
        ElseIf new_nm = "" Then
            Cells(t_row, 4) = "変更後ファイル名が空欄です。"
        
        '□変更前ファイルが存在しない場合
        ElseIf Dir(pt & old_nm) = "" Then
            Cells(t_row, 4) = "変更前ファイルが存在しません。"
        
        '□変更後ファイル名が既に存在する場合
        ElseIf Dir(pt & new_nm) <> "" Then
            Cells(t_row, 4) = "変更後ファイル名は既に存在します。"
            
        '■ファイル名の変更
        Else
            Name pt & old_nm As pt & new_nm
        End If
    Next t_row
    
    MsgBox "処理が完了しました！"

End Sub

■■■スポンサーリンク■■■

マクロの実行

元のExcelの画面に戻り、ボタン用に作ったオブジェクトを選択し、右クリックー［マクロの登録］を選択します。

＜ファイル名取得＞ボタンには
マクロの保存先ー［作業中のブック］にして「ファイル名取得」マクロを選択し、＜OK＞ボタンをクリックします。

＜ファイル名変更＞ボタンには
マクロの保存先ー［作業中のブック］にして「ファイル名変更」マクロを選択し、＜OK＞ボタンをクリックします。

セルA2のフォルダパスに、ファイル名を取得したいフォルダのフルパスを入力し、＜ファイル名取得＞ボタンをクリックすると・・・

←メッセージが表示されて

セルA7以下に、セルA2に指定したフォルダ内のファイル名が取得されます。

その後、C列に変更後のファイル名を入力します。
ファイル名を変更しない場合は、変更前のファイル名または空欄にします。

最後に、＜ファイル名変更＞ボタンをクリックします。

←メッセージが表示されて

ファイル名が変換されました。

下記のような場合は、ファイル名は変更されません。

変更後ファイル名に使用できない文字列が含まれている
変更前ファイル名が空欄
変更後ファイル名が空欄
変更前ファイルが存在しない
変更後ファイル名が既に存在する(変更前ファイル名と同じ）

ファイル名が変更されなかった場合、D列の備考欄に「変更されなかった理由」が記載されます。

Dir関数

Dir関数は、第1引数に指定したファイル・フォルダが存在する場合、パスを除いたファイル名・フォルダ名を返します。存在しない場合は長さ0の文字列 ”” （空欄）を返します。

Dir（ファイル・フォルダのパス,ファイル・フォルダの属性）

第1引数にはワイルドカードを使用することができるので、取得したいファイル名・フォルダ名の幅を広げることができます。

参考：ワイルドカードとは。使い方いろいろ。（Excel）

Dir(“C:\VBA\写真\*.*”) の場合

ファイルが存在する場合（ファイル名を返す）→ A0454.JPG
ファイルが存在しない場合（空欄を返す） → ””

第2引数に下記定数（値）を指定することで、特定の属性のオブジェクトのみを取得の対象とすることができます。

定数	値	属性
vbNormal (既定)	0	標準ファイル
vbReadOnly	1	読み取り専用ファイル
vbHidden	2	隠しファイル
vbSystem	4	システムファイル
vbVolume	8	ボリュームラベル。この値を指定すると、すべての属性は無効になります。
vbDirectory	16	フォルダ
vbAlias	64	エイリアスファイル

フォルダ名を取得したい場合は、第2引数に「vbDirectory」を指定します。

Dir関数でのフォルダ名取得は少し複雑ですので、もう少し詳しいことが知りたい方はコチラをご参考ください。→Dir関数の使い方。ファイル名やフォルダ名の取得方法。（Excel VBA）

'■指定したフォルダパスが存在するか確認
If Dir(pt, vbDirectory) = "" Then
    MsgBox "ご指定のフォルダパスは存在しません。"
    Exit Sub
End If

Dir関数は一度引数を指定すると、次に別の引数を指定するまで、同じ引数に対する処理を行います。

fn =Dir("C:\VBA\写真\*.*"）
fn =Dir()
fn =Dir()

1行目の処理では、変数 fn に「C:\VBA\写真\*.*」に一致するファイルが存在すれば、そのファイル名を返します。

2行目以降の「fn=Dir()」では引数を指定していませんが、「C:\VBA\写真\*.*」に一致する別のファイル名を返します。

その処理を繰り返し、「C:\VBA\写真\*.*」に一致するファイルが無くなった時、長さ0の文字列 ”” 空欄 を返します。

何度も「fn=Dir()」を書くのは面倒だし、どのタイミングでファイルが無くなるかわからないので、Do While ～ Loopを使って繰り返し処理を行います。

'■指定フォルダパス内のファイル名の取得が終わるまでLoop
fn = Dir(pt & "*.*") '指定フォルダパス内の1個目のファイル名を取得
Do While fn <> ""
    Cells(t_row, 1) = fn   'A列にファイル名取得
    t_row = t_row + 1      'ファイル名取得行+1
    fn = Dir()             '指定フォルダパス内の次のファイル名を取得
Loop

ファイルチェック

ファイル名を変えようとした時に、変更前ファイルや変更後ファイルに不具合があると、エラーで止まってしまいます。

事前に不具合がないか確認しておきます。

変更後ファイル名に使用できない文字列が含まれている
＜使用できない文字＞
\　/　:　*　?　”　<　>　|
変更前ファイル名が空欄
変更後ファイル名が空欄
変更前ファイルが存在しない
変更後ファイル名が既に存在する(変更前ファイル名と同じ）

'■ファイルチェック
'□変更後ファイル名に使用できない文字列が含まれている場合
If InStr(new_nm, "\") > 0 Or InStr(new_nm, "/") > 0 Or _
    InStr(new_nm, ":") > 0 Or InStr(new_nm, "*") > 0 Or _
    InStr(new_nm, "?") > 0 Or InStr(new_nm, """") > 0 Or _
    InStr(new_nm, "<") > 0 Or InStr(new_nm, ">") > 0 Or _
    InStr(new_nm, "|") > 0 Then
    Cells(t_row, 4) = "変更後ファイル名にファイル名に使用できない文字列が含まれています。"
        
    '□変更前ファイル名が空欄の場合
    ElseIf old_nm = "" Then
        Cells(t_row, 4) = "変更前ファイル名が空欄です。"
        
    '□変更後ファイル名が空欄の場合
    ElseIf new_nm = "" Then
        Cells(t_row, 4) = "変更後ファイル名が空欄です。"
        
    '□変更前ファイルが存在しない場合
    ElseIf Dir(pt & old_nm) = "" Then
        Cells(t_row, 4) = "変更前ファイルが存在しません。"
        
    '□変更後ファイル名が既に存在する場合
    ElseIf Dir(pt & new_nm) <> "" Then
        Cells(t_row, 4) = "変更後ファイル名は既に存在します。"

Nameステートメント

古いファイル名（フォルダ名）を、新しいファイル名（フォルダ名）に変更します。

Name 古いファイル（フォルダ）パス As 新しいファイル（フォルダ）パス

新しいファイル名（フォルダ名）パスに、既に存在するファイル名（フォルダ名）パスを指定するとエラーになるので、Nameステートメントを使用する前にDir関数を用いてエラーチェクをしておきます。

【参考】

■■■スポンサーリンク■■■