【Excel VBA】サブフォルダを含むファイル名を取得する方法!拡張子無し版も!

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

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

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

ですよね。

今回はそんなお悩みを解決する
Excel VBAでサブフォルダを含むフォルダ内のファイル名を取得する方法とオプションで拡張子なし版の方法について
まとめます!


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

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

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

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

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

エクセルにシートを追加し、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の実装手順

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

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

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

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

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

こちらで完了です。

VBAを実行する

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

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

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


さいごに

いかがでしょうか。

今回は、
Excel VBAでサブフォルダを含むフォルダ内のファイル名を取得する方法とオプションで拡張子なし版の方法について
まとめました。

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



コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です