（作成例）指定したｱﾄﾞﾚｽにあるサブフォルダとファイル名を出力する

指定したｱﾄﾞﾚｽ内のサブフォルダとファイル名（拡張子は事前に指定すること）を抽出する。



<サンプル>

    Const kaku As String = ".txt" '抽出する拡張子


Sub aaaa()
' 指定したフォルダ内のファイルの一覧をシートへ出力する
    Const cnsTitle = "フォルダ内のファイル名一覧取得"
    Const cnsDIR = "\*.*"
    Dim myAPP As Application
    Dim myPath As String
    Dim myFileName As String
    Dim i As Long

    Set myAPP = Application
    ' InputBoxでフォルダ指定を受ける
    myPath = myAPP.InputBox("参照するフォルダ名を入力して下さい。", _
                                 cnsTitle, "C:")
   
    ' フォルダの存在確認
    If Dir(myPath, vbDirectory) = "" Then
        MsgBox "指定のフォルダは存在しません。", vbExclamation, cnsTitle
        Exit Sub
    End If

    ' 先頭のファイル名の取得
    myFileName = Dir(myPath & cnsDIR, vbDirectory)
    ' サブフォルダが見つからなくなるまで繰り返す
    Do While myFileName <> ""
        If GetAttr(myPath) And vbDirectory Then
            If myFileName <> "." And myFileName <> ".." Then
                If InStr(myFileName, kaku) > 0 Then
                '-1：指定した拡張子の場合 →　≪ファイル名≫の形式にする
                    i = i + 1 ' 行を加算
                    Cells(i, 1).Value = "≪" & myFileName & "≫"
               
                Else
                '-2：フォルダの場合 →　フルパスを取得
                    i = i + 1 ' 行を加算
                    Cells(i, 1).Value = myPath & "\" & myFileName
                End If
            End If
        End If

        ' 次のファイル名を取得
        myFileName = Dir()
    Loop

End Sub