【Excel】VBAマクロでフォルダ名を取得（フォルダ内の：サブフォルダも：一覧に：階層：すべて取得しセルに追記・入力）する方法【Dir, FileSystemObject, GetFolder, SubFolders】

Sub GetFolderNames()
    'Dir関数を使ってフォルダ名を取得する
    Dim saisyoNoBasyo As String
    saisyoNoBasyo = "C:\Sample" 'フォルダのパスを指定
    
    Dim iFolderCount As Integer
    iFolderCount = 1
    
    Dim folderMei As String
    folderMei = Dir(saisyoNoBasyo, vbDirectory)
    
    Do While folderMei <> ""
        If folderMei <> "." And folderMei <> ".." Then
            Cells(1 + iFolderCount, 2).Value = folderMei 'B2セルから順にフォルダ名を追記
            iFolderCount = iFolderCount + 1
        End If
        folderMei = Dir() 'フォルダ名を順番に取得
    Loop
End Sub

  
Sub GetAllFolderNames()
    'FileSystemObjectを使って階層下のすべてのフォルダ名を取得
    Dim oFileSys As Object
    Set oFileSys = CreateObject("Scripting.FileSystemObject")
    
    Dim saisyoNoBasyo As String
    saisyoNoBasyo = "C:\Sample" 'フォルダのパスを指定
    
    Dim topFolder As Object
    Set topFolder = oFileSys.GetFolder(saisyoNoBasyo)
    
    Dim iFolderCount As Integer
    iFolderCount = 1
    
    Call GetSubFolders(topFolder, 2, iFolderCount)
End Sub

Sub GetSubFolders(ByVal oParentFolder As Object, ByVal iColumn As Integer, ByRef iFolderCount As Integer)
    ' 再帰処理で階層下のすべてのフォルダ名を取得
    Dim oSubFolder As Object
    
    For Each oSubFolder In oParentFolder.SubFolders
        Cells(iFolderCount, iColumn).Value = oSubFolder.Name 'フォルダ名をセルに追記
        iFolderCount = iFolderCount + 1
        Call GetSubFolders(oSubFolder, iColumn + 1, iFolderCount) '再帰的に次のサブフォルダを処理
    Next oSubFolder
End Sub