VBA フォルダ一覧を取得する

Option Explicit
Const WS_NAME As String = "一覧"

Sub GetFolderNameList()
    Dim fso As Object
    Dim pfl As Object
    Dim fl As Object
    Dim n As Long
    Dim pFolderName As String
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    pFolderName = GetFolderName
    Set pfl = fso.GetFolder(pFolderName) ' 親フォルダを取得
    
    n = 1
    With ThisWorkbook.Worksheets(WS_NAME)
    .Cells.Clear
        For Each fl In pfl.SubFolders ' 子フォルダの一覧を取得
            .Range("A" & n).Value = fl.Name
            n = n + 1
        Next
          .Columns("A:A").EntireColumn.AutoFit
          .Range("A1").Select
    End With
    
    
    Set pfl = Nothing
    Set fso = Nothing
    MsgBox "完了"
    
End Sub

'フォルダ選択ダイアログから、選択されたフォルダパスを取得
Function GetFolderName()
    Dim folderName As String
    folderName = ""
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダ選択"
        If .Show = True Then
            folderName = .SelectedItems(1) 'フルパス
            
        Else
            MsgBox "フォルダを選択してください"
            End
        End If
    End With
    GetFolderName = folderName
End Function