Dir フォルダ一覧を作成するExcel関数

Option Explicit

'フォルダ選択ダイアログExcel標準モジュールコード (初期フォルダを指定する方法)
Public Function SelectFolder_FileDialog(iniDir As String) As String
    Dim s1 As String
    
    'フォルダ選択ダイアログ
    With Application.FileDialog(msoFileDialogFolderPicker)
        'タイトル
        .Title = "フォルダを選択してください"
        '初期フォルダ
        .InitialFileName = iniDir
        If .Show = -1 Then
            '選択された
            s1 = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
            If Right$(s1, 1) <> "\" Then s1 = s1 + "\"
            SelectFolder_FileDialog = s1
        Else
            SelectFolder_FileDialog = ""
        End If
    End With
End Function

Private Sub MyGetFolder(sFolder As String)
    Dim sfina As String
    Dim lrow As Long
    
    lrow = 7
    sfina = Dir(sFolder, vbDirectory)
    Do While sfina <> ""
        Cells(lrow, 2) = sfina
        lrow = lrow + 1
        sfina = Dir
    Loop
End Sub

Private Sub CommandButton1_Click()
    Dim sFolder As String
    
    sFolder = SelectFolder_FileDialog("c:\")
    If sFolder <> "" Then
        MyGetFolder sFolder
    End If
End Sub