2023.03.28 Excel VBA タカヒロ@extan

【Excel VBA】サブフォルダを含むファイル名・パスを取得する方法！拡張子削除も対応！

Excel VBAでサブフォルダを含むフォルダ内のファイル名やパスを取得したいときはないでしょうか。

けど、そんな中で悩むことは、

・Excel VBAでサブフォルダを含む読者様より要望がありましたフォルダ内のファイル名やパスを取得するやり方がわからない。
・拡張子を取り除くなど出力したファイル名を加工したいがやり方がわからない。

ですよね。

今回はそんなお悩みを解決する

・Excel VBAでサブフォルダを含むフォルダ内のファイル名やパスを取得する方法
・Excel VBAでサブフォルダを含むフォルダ内のファイル名やパスを取得し拡張子部分を削除する方法

についてまとめます！

Excel VBAでサブフォルダを含むフォルダ内のファイル名やパスを取得する完成イメージ

Excel VBAでサブフォルダを含むフォルダ内のファイル名やパスを取得する完成イメージについて説明します。

前回の「【Excel VBA】フォルダ内のファイル名やパスを取得する方法！拡張子無し版も！」は1階層目のみのファイル名取得でしたが、今回は2階層目にあるサブフォルダとファイル名を含む情報を取得していきます。

まず、ファイル一覧を取得したいフォルダへアクセスし、パス情報を取得します。

2階層目も同じようにファイルが入っています。

Excelにシートを追加し、B1セルへそのパスを貼り付けます。

VBAを実行すると、黄色い背景の箇所にサブフォルダを含むファイル名とフォルダ名、そのパスであるディレクトリ情報が出力されます。

このような形で出力されます。

さらに拡張子を除く処理を加え、ファイルの拡張子を除いたファイル名一覧を出力していきます。

それではさっそくやってみましょう。

サブフォルダを含むフォルダ内のファイル名やパスを取得するVBA

フォルダ内のファイル名やパスを取得するVBAを実装していきましょう。

以下サンプルコードです。

Sub サブフォルダ含むファイル名取得()

Dim intIchi As Integer
Dim strFolderpass As String

'ファイル名一覧を出力する行番号を指定します。
intIchi = 3

'対象フォルダのパスがあるセルを指定し、値を代入します。
strFolderpass = Range("B1").Value

'指定範囲の値をクリアします。
Range("A3:B10000").Clear

'ファイル名取得プロシージャを呼び出します。
Call ファイル名取得プロシージャ(strFolderpass, intIchi)

End Sub




Sub ファイル名取得プロシージャ(strFolderpass As String, intIchi As Integer)

Dim objfFSO As Object
Dim objFiles As Object
Dim objFile As Object
Dim objSubFolders As Object
Dim objSubFolder As Object


'対象フォルダのパスの値があれば処理をおこないます。
If strFolderpass = "" Then
    MsgBox "対象フォルダのパスがありません。パスを入力してください。"
Else

    'FileSystemObjectはファイルやフォルダを操作する専用のオブジェクトです｡インスタンスにセットします。
    Set objfFSO = CreateObject("Scripting.FileSystemObject")

    '対象フォルダのファイルオブジェクトをセットします。
    Set objFiles = objfFSO.GetFolder(strFolderpass).Files
    
    'ファイル情報を出力します。
    For Each objFile In objFiles
        Cells(intIchi, 1) = objFile.Name
        Cells(intIchi, 2) = objFile.Path
        intIchi = intIchi + 1
    Next objFile
    

    '対象フォルダのサブフォルダファイルオブジェクトをセットします。
    Set objSubFolders = objfFSO.GetFolder(strFolderpass).SubFolders

    'サブフォルダを含むファイル名取得の処理をおこないます。
    For Each objSubFolder In objSubFolders
     
        If objSubFolder.Name <> "" Then
            Cells(intIchi, 1) = objSubFolder.Name
            Cells(intIchi, 2) = objSubFolder.Path
            intIchi = intIchi + 1
            
            'サブフォルダのパスを本プロシージャへ渡して再帰的に処理を繰り返します。
            Call ファイル名取得プロシージャ(objSubFolder.Path, intIchi)
            
        End If
         
    Next objSubFolder

End If

Set objfFSO = Nothing
Set objFiles = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing
Set objSubFolder = Nothing

End Sub

VBAの設定

以下の設定をおこないます。

ファイル名一覧を出力する行番号を指定します。サンプルではA3から出力していますので3行目の3を入れています。

intIchi = 3

対象フォルダのパスがあるセルを指定します。上記の通りB1セルを指定します。

strFolderpass = Range(“B1”).Value

指定範囲の値をクリアします。これは再実行時に前の出力値を残さないようにするためにする設定です。
1万行以上ある場合は数値の部分を変更してください。

Range(“A3:B10000”).Clear

では実行してみましょう。

はい、指定フォルダの一階層目以降のファイル名とフォルダ名が取得できていますね。

VBAの説明

前回の1階層目のみの処理と異なる点は、ファイル名取得プロシージャを独立させ、サブフォルダの階層分繰り返して処理を行うようにしています。

プロシージャを呼び出している箇所は初回処理と、

Call ファイル名取得プロシージャ_拡張子削除(strFolderpass, intIchi)

サブフォルダがあった場合の再帰処理の2か所になります。

Call ファイル名取得プロシージャ_拡張子削除(objSubFolder.Path, intIchi)

ファイル名を取得しているのはFileSystemObjectで、
ファイルやフォルダを操作したり、情報を取得するオブジェクトとなり、
このFileSystemObjectオブジェクトをインスタンスにセットします。

Set objfFSO = CreateObject(“Scripting.FileSystemObject”)

タカヒロ

この箇所でエラーとなった場合は、VBEを開き、ツール＞参照設定へアクセスし、
「Microsoft Scripting Runtime」にチェックを入れてください。

Filesプロパティ対象フォルダのファイルオブジェクトをセットします。

Set objFiles = objfFSO.GetFolder(strFolderpass).Files

ファイルオブジェクトから一件づつファイル情報を出力します。
Nameプロパティでファイル名をPathプロパティでディレクトリ情報を取得し、セルへ代入しています。

For Each objFile In objFiles
Cells(intIchi, 1) = objFile.Name
Cells(intIchi, 2) = objFile.Path
intIchi = intIchi + 1
Next objFile

サブフォルダ分も同様に処理していきます。

対象フォルダのサブフォルダファイルオブジェクトをセットします。

Set objSubFolders = objfFSO.GetFolder(strFolderpass).SubFolders

サブフォルダを含むファイル名取得の処理をおこないます。

For Each objSubFolder In objSubFolders

サブフォルダ内のファイル名やパスがある場合処理を継続します。

If objSubFolder.Name <> “” Then

前回1階層目のみ取得の場合はファイル名に限定されますが、サブフォルダを含む場合はフォルダ名を含む形で出力されます。

サブフォルダを含むフォルダ内のファイル名やパスを取得し拡張子部分を削除するVBA

次に取得したファイル名一覧からドット「.」以下の拡張子を取り除いていきましょう。

以下サンプルコードです。

Sub サブフォルダ含むファイル名取得()

Dim intIchi As Integer
Dim strFolderpass As String

'ファイル名一覧を出力する行番号を指定します。
intIchi = 3

'対象フォルダのパスがあるセルを指定し、値を代入します。
strFolderpass = Range("B1").Value

'指定範囲の値をクリアします。
Range("A3:B10000").Clear

'ファイル名取得プロシージャを呼び出します。
Call ファイル名取得プロシージャ_拡張子削除(strFolderpass, intIchi)

End Sub




Sub ファイル名取得プロシージャ_拡張子削除(strFolderpass As String, intIchi As Integer)

Dim objfFSO As Object
Dim objFiles As Object
Dim objFile As Object
Dim objSubFolders As Object
Dim objSubFolder As Object


'対象フォルダのパスの値があれば処理をおこないます。
If strFolderpass = "" Then
    MsgBox "対象フォルダのパスがありません。パスを入力してください。"
Else

    'FileSystemObjectはファイルやフォルダを操作する専用のオブジェクトです｡インスタンスにセットします。
    Set objfFSO = CreateObject("Scripting.FileSystemObject")

    '対象フォルダのファイルオブジェクトをセットします。
    Set objFiles = objfFSO.GetFolder(strFolderpass).Files
    
    'ファイル情報を出力します。
    For Each objFile In objFiles
        Cells(intIchi, 1) = objFile.Name
        
        '拡張子を削除したファイル名を出力します。
        If InStrRev(objFile.Name, ".") Then
            'InStrRevで右から"."の位置を取得し、それ以降の文字列を抽出します。
            Cells(intIchi, 1) = Left(objFile.Name, InStrRev(objFile.Name, ".") - 1)
        End If
        
        Cells(intIchi, 2) = objFile.Path
        intIchi = intIchi + 1
    Next objFile
    

    '対象フォルダのサブフォルダファイルオブジェクトをセットします。
    Set objSubFolders = objfFSO.GetFolder(strFolderpass).SubFolders

    'サブフォルダを含むファイル名取得の処理をおこないます。
    For Each objSubFolder In objSubFolders
     
        If objSubFolder.Name <> "" Then
            Cells(intIchi, 1) = objSubFolder.Name
            
            '拡張子を削除したファイル名を出力します。
            If InStrRev(objSubFolder.Name, ".") Then
                'InStrRevで右から"."の位置を取得し、それ以降の文字列を抽出します。
                Cells(intIchi, 1) = Left(objSubFolder.Name, InStrRev(objSubFolder.Name, ".") - 1)
            End If
            
            Cells(intIchi, 2) = objSubFolder.Path
            intIchi = intIchi + 1
            
            'サブフォルダのパスを本プロシージャへ渡して再帰的に処理を繰り返します。
            Call ファイル名取得プロシージャ_拡張子削除(objSubFolder.Path, intIchi)
            
        End If
         
    Next objSubFolder

End If

Set objfFSO = Nothing
Set objFiles = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing
Set objSubFolder = Nothing

End Sub

VBAの説明

設定内容は先ほどのVBAと同じで、拡張子を取り除く処理だけを追加しています。

拡張子を削除したファイル名を出力します。
InStrRev関数で右から指定ワードに合致した位置を取得し、Left関数でそれ以降の文字を抽出していきます。

‘If InStrRev(objFile.Name, “.”) Then
‘Cells(intIchi, 1) = Left(objFile.Name, InStrRev(objFile.Name, “.”) – 1)
‘End If

タカヒロ

Inster関数だと左から指定ワードを探しに行きますので、例えば「test1.2021.8.xls」だと「test1.2021.8」とはならずに「test1」となってしまいます。
拡張子など右の文字から判定する場合は、InStrRev関数を追加しましょう。

では実行してみましょう。

はい、指定フォルダの一階層目以降のファイル名が拡張子を取り除いた形で取得されていますね。

＜追加＞指定した拡張子のファイルに絞り込んでファイル名とパスを取得するVBA

読者様からの要望で、指定した拡張子のみのファイルに絞り込んでファイル名とパスを取得する方法について追記します。

以下の部分のコードを変更します。
■変更前

    'ファイル情報を出力します。

For Each objFile In objFiles

Cells(intIchi, 1) = objFile.Name

Cells(intIchi, 2) = objFile.Path

intIchi = intIchi + 1

Next objFile

■変更後
サンプルは拡張子が”.zip”のファイルのみが対象となるよう指定をしています。

    'ファイル情報を出力します。

For Each objFile In objFiles

If InStr(objFile.Name, ".zip") Then

Cells(intIchi, 1) = objFile.Name

Cells(intIchi, 2) = objFile.Path

intIchi = intIchi + 1

End If

Next objFile

複数の拡張子を指定したい場合は「Or」でつなげて追加します。
サンプルは拡張子が”.zip”、”.csv”、”.xlsm”のファイルのみが対象となるよう指定をしています。

    'ファイル情報を出力します。

For Each objFile In objFiles

If InStr(objFile.Name, ".zip") Or InStr(objFile.Name, ".csv") Or InStr(objFile.Name, ".xlsm") Then

Cells(intIchi, 1) = objFile.Name

Cells(intIchi, 2) = objFile.Path

intIchi = intIchi + 1

End If

Next objFile

タカヒロ

各拡張子の値は絞り込みたい拡張子名に随時変えてください。

＜追加＞ファイルのサイズ（容量）を取得するVBA

ファイル名とパスの他にサイズ（容量）を取得する方法について追記します。

以下の部分のコードを変更します。
■変更前

    'ファイル情報を出力します。

For Each objFile In objFiles

Cells(intIchi, 1) = objFile.Name

Cells(intIchi, 2) = objFile.Path

intIchi = intIchi + 1

Next objFile

■変更後
サンプルはC列に対象ファイルの容量を出力する内容となっています。

    'ファイル情報を出力します。

For Each objFile In objFiles

Cells(intIchi, 1) = objFile.Name

Cells(intIchi, 2) = objFile.Path

Cells(intIchi, 3) = objFile.Size

intIchi = intIchi + 1

Next objFile

タカヒロ

サイズの単位はバイトとなっています。～KB単位にするには1000、～MB単位は100万で元の数値と割るようにしてください。

＜追加＞ファイルの更新日を取得するVBA

ファイル名とパスとサイズ（容量）に加え、更新日を取得する方法について追記します。

以下の部分のコードを変更します。
■変更前

    'ファイル情報を出力します。

For Each objFile In objFiles

Cells(intIchi, 1) = objFile.Name

Cells(intIchi, 2) = objFile.Path

intIchi = intIchi + 1

Next objFile

■変更後
サンプルはD列に対象ファイルの更新日を出力する内容となっています。

    'ファイル情報を出力します。

For Each objFile In objFiles

Cells(intIchi, 1) = objFile.Name

Cells(intIchi, 2) = objFile.Path

Cells(intIchi, 3) = objFile.Size

Cells(intIchi, 4) = objFile.DateLastModified

intIchi = intIchi + 1

Next objFile

＜追加＞階層の数を指定しファイル名とパスを取得するVBA

読者様からの要望で、指定した階層の数に絞り込んでファイル名とパスを取得する方法について追記します。

Excelシート側に階層指定セルを設ける

Excelシート側に階層指定セルをD1に設け、取得したい階層の数を入力します。

フォルダを用意する

テスト用のフォルダを用意しましょう。今回は4階層分作成しました。

サンプルコード

階層の数を指定しファイル名とパスを取得するVBAコードは以下の通りです。

Sub サブフォルダ含むファイル名取得()

Dim intIchi As Integer
Dim strFolderpass As String
Dim intPassCnt As Integer
Dim intKaisou As Integer

'ファイル名一覧を出力する行番号を指定します。
intIchi = 3

'対象フォルダのパスがあるセルを指定し、値を代入します。
strFolderpass = Range("B1").Value

'指定範囲の値をクリアします。
Range("A3:B10000").Clear

'取得したい階層を指定します。
intKaisou = Range("D1").Value

'指定パスの階層を取得します。
intPassCnt = UBound(Split(strFolderpass, "\"))

'ファイル名取得プロシージャを呼び出します。
Call ファイル名取得プロシージャ_階層指定版(strFolderpass, intIchi, intPassCnt, intKaisou)

End Sub


Sub ファイル名取得プロシージャ_階層指定版(strFolderpass As String, intIchi As Integer, intPassCnt As Integer, intKaisou As Integer)

Dim objfFSO As Object
Dim objFiles As Object
Dim objFile As Object
Dim objSubFolders As Object
Dim objSubFolder As Object


'対象フォルダのパスの値があれば処理をおこないます。
If strFolderpass = "" Then
    MsgBox "対象フォルダのパスがありません。パスを入力してください。"
Else

    'FileSystemObjectはファイルやフォルダを操作する専用のオブジェクトです｡インスタンスにセットします。
    Set objfFSO = CreateObject("Scripting.FileSystemObject")

    '対象フォルダのファイルオブジェクトをセットします。
    Set objFiles = objfFSO.GetFolder(strFolderpass).Files
    
    'ファイル情報を出力します。
    For Each objFile In objFiles
        Cells(intIchi, 1) = objFile.Name
        Cells(intIchi, 2) = objFile.Path
        intIchi = intIchi + 1
    Next objFile
    

    '対象フォルダのサブフォルダファイルオブジェクトをセットします。
    Set objSubFolders = objfFSO.GetFolder(strFolderpass).SubFolders

    'サブフォルダを含むファイル名取得の処理をおこないます。
    For Each objSubFolder In objSubFolders
  
        If objSubFolder.Name <> "" Then
            '指定階層に達したか判定します。
            If intKaisou >= UBound(Split(objSubFolder.Path, "\")) - intPassCnt Then
                Cells(intIchi, 1) = objSubFolder.Name
                Cells(intIchi, 2) = objSubFolder.Path
                intIchi = intIchi + 1
                
                'サブフォルダのパスを本プロシージャへ渡して再帰的に処理を繰り返します。
                Call ファイル名取得プロシージャ_階層指定版(objSubFolder.Path, intIchi, intPassCnt, intKaisou)
            
            End If
        End If

    Next objSubFolder

End If

Set objfFSO = Nothing
Set objFiles = Nothing
Set objFile = Nothing
Set objSubFolders = Nothing
Set objSubFolder = Nothing

End Sub

実行をする

さっそく実行してみましょう。

3階層を指定し実行をする

3階層を指定しファイル名とパスが取得できる確認をしましょう。

はい、3階層に限定され取得できていますね！

他の階層も同様に指定し確認してみましょう。

1階層を指定し実行をする

1階層に限定され取得できています。

2階層を指定し実行をする

2階層に限定され取得できています。

4階層を指定し実行をする

4階層に限定され取得できています！OKですね！

VBAの実装手順

実装手順は以下の通りです。

今回はExcel側にこのVBAを実装します。

①Excelを新規に開き、「開発」タブをクリックし、「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」＋「F11」でもOKです。

②標準モジュールを追加します。
左ペインのVBAProjectを右クリックし、「挿入」、「標準モジュール」を選択します。

③右ペインのウインドウに上記のVBAを入力します。

こちらで完了です。

VBAを実行する

では早速VBAの実行をしてみましょう。

①「開発」タブの「VBA」をクリックし実行したいマクロを選択し、「実行」をクリックします。

②処理がされたことが確認できれば完了です。
※完了メッセージやステータス管理など必要に応じて実装してもらえばと思います。

さいごに

いかがでしょうか。

今回は、

についてまとめました。

また、他にも便利な方法がありますので、よろしければご参照頂ければと思います。

11 件のコメント

指定したフォルダの３階層目までのフォルダの名前を取得できるVBAコードをおしえていただきたいです。

返信する

タカヒロ@extan より:

2023年3月28日 6:49 PM

いつもご利用ありがとうございます。

3階層指定の方法について記事に追加いたしましたので、
よろしければご参考ください。
https://extan.jp/?p=5057#%EF%BC%9C%E8%BF%BD%E5%8A%A0%EF%BC%9E%E9%9A%8E%E5%B1%A4%E3%81%AE%E6%95%B0%E3%82%92%E6%8C%87%E5%AE%9A%E3%81%97%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E5%90%8D%E3%81%A8%E3%83%91%E3%82%B9%E3%82%92%E5%8F%96%E5%BE%97%E3%81%99%E3%82%8BVBA

返信する

初めて拝見させて頂きました。VBAを勉強中の身です。
親切に説明されていて非常に参考になります。ありがとうございます。

記事に追記頂いた「ファイルの拡張子を指定し絞り込む方法」のIF文を追加する場所が、上述のサンプルコードのどこにあたるか分かりませんでした。
（自分なりに試してみましたが結果が変わらず。。）

さらに具体的に示していただけると非常にありがたいです。
よろしくお願いします。

返信する

タカヒロ@extan より:

2022年9月21日 12:07 PM

いつもご利用ありがとうございます。
「ファイルの拡張子を指定し絞り込む方法」のIF文を追加する場所につきまして、
「ファイル名取得プロシージャ」内の以下のコードを

‘ファイル情報を出力します。
For Each objFile In objFiles
Cells(intIchi, 1) = objFile.Name
Cells(intIchi, 2) = objFile.Path
intIchi = intIchi + 1
Next objFile

IF文付きのコードへ変更いただき、
“.zip”の箇所を取得したい拡張子に変更いただきたくお願いいたします。

‘ファイル情報を出力します。
For Each objFile In objFiles
If InStr(objFile.Name, “.zip”) Then
Cells(intIchi, 1) = objFile.Name
Cells(intIchi, 2) = objFile.Path
intIchi = intIchi + 1
End If
Next objFile

※不明な場合はコード内を「 ‘ファイル情報を出力します。」で検索するとすぐわかるかと思います。

返信する