【Excel VBA】フォルダ内のフォルダ名を取得する方法！サブフォルダ名も取得可！

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

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

・Excel VBAでサブフォルダを含むフォルダ内のフォルダ名を取得するやり方がわからない。
・ファイル名を除いてフォルダ名のみ取得したいがやり方がわからない。

ですよね。

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

・Excel VBAでサブフォルダを含むフォルダ内のフォルダ名を取得する方法

についてまとめます！

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

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

前回の「【Excel VBA】サブフォルダを含むファイル名を取得する方法！拡張子無し版も！」はファイル名を含むフォルダ名の取得でしたが、今回はフォルダ名のみに絞り込み取得していきます。

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

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

        '拡張子の有無をチェックし、ない場合はフォルダと判断し出力します。
        If InStr(objFile.Name, ".") = 0 Then
             Cells(intIchi, 1) = objFile.Name
             Cells(intIchi, 2) = objFile.Path
             intIchi = intIchi + 1
        End If
        
    Next objFile
    

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

    'サブフォルダを含むフォルダ名取得の処理をおこないます。
    For Each objSubFolder In objSubFolders
     
        If objSubFolder.Name <> "" Then

            '拡張子の有無をチェックし、ない場合はフォルダと判断し出力します。
            If InStr(objSubFolder.Name, ".") = 0 Then
                    Cells(intIchi, 1) = objSubFolder.Name
                    Cells(intIchi, 2) = objSubFolder.Path
                    intIchi = intIchi + 1
            End If
            
            
            'サブフォルダのパスを本プロシージャへ渡して再帰的に処理を繰り返します。
            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