フォルダ内のファイル一覧の取得

フォルダを指定して、そのフォルダのファイル一覧を取得するサンプルです。
単一フォルダと配下のフォルダを含めたファイル一覧を取得します。 ここでは、古くからあるDir関数を用いた単一フォルダ内のファイル一覧の取得を行なうサンプルと、FileSystemObject(FSO)を使って指定フォルダから配下の全サブフォルダも含めてファイルの一覧を取得する2つのサンプルを紹介します。
まずは、Dir関数を用いた単一フォルダ内のファイル一覧の取得です。
フォルダの指定はInputBoxで入力してもらうことにします。実際の一覧取得とシートへの展開を行なっている記述は下半分だけです。

Option Explicit

' 指定したフォルダ内のファイルの一覧を取得
Sub Display_Directory()
    Const cnsTitle = "フォルダ内のファイル名一覧取得"
    Const cnsDIR = "\*.*"
    Dim xlAPP As Application
    Dim strPathName As String, vntPathName As Variant
    Dim strFileName As String
    Dim GYO As Long

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

    ' 先頭のファイル名の取得
    strFileName = Dir(strPathName & cnsDIR, vbNormal)                   ' B
    ' ファイルが見つからなくなるまで繰り返す
    Do While strFileName <> ""                                          ' C
        ' 行を加算
        GYO = GYO + 1       ' 先頭は1行目
        Cells(GYO, 1).Value = strFileName                               ' D
        ' 次のファイル名を取得
        strFileName = Dir()                                             ' E
    Loop

End Sub
(ここをクリックすると、このサンプルがダウンロードできます)
@
InputBoxでフォルダ名の指定を受けます。
A
InputBoxは単なる手入力なので正しいか判りません。このため指定フォルダが存在するかを確認しています。
B
指定フォルダの先頭のファイル名を取得します。
C
ファイル名が受け取れなくなるまで繰り返します。
D
ファイル名をシートに転記しています。
E
次のファイル名を受け取ります。

では、FileSystemObject(FSO)を使って、配下の全フォルダも探索する方法です。
Dir関数はDOS時代(Windows以前)から存在するステートメントです。 「オブジェクト」などの意識なく使えるので初心者向きと言えますが、ネットワーク環境で発生する極端に長いフルパスには対応できません。 FileSystemObject(FSO)でもWindowsの物理的限度とは相違があるそうですが、Dir関数よりは良いということです。
では、ここでFileSystemObject(FSO)を使って、さらに「再帰処理」で配下のサブフォルダ全てを探索してファイル名の一覧を作成するサンプルを提示します。
※この記述方法では「Microsoft Scripting Runtime」の参照設定が必要です。

'*******************************************************************************
'   FSOでフォルダ内のファイル一覧を取得しシート上に展開する(含むサブフォルダ)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
' [参照設定]
'   ・Microsoft Scripting Runtime
'*******************************************************************************
Option Explicit
Private g_cntFILE As Long
Private g_cntPATH As Long

'*******************************************************************************
'   全体処理(ルートフォルダを指定して探索を開始)
'*******************************************************************************
Sub SEARCH_FOLDER()
    Dim objFSO As FileSystemObject
    Dim strPATHNAME As String

    ' ルートとなるフォルダの指定(※modFolderPicker1.bas)
    strPATHNAME = modFolderPicker1.FolderDialog( _
        "ルートフォルダを指定して下さい。", True)
    If strPATHNAME = "" Then Exit Sub
    ' 処理開始
    Cells.ClearContents
    Set objFSO = New FileSystemObject           ' FSO
    ' ルートフォルダから探索開始
    Call SEARCH_SUB_FOLDER(objFSO.GetFolder(strPATHNAME), 0, 0)
    ' 参照OBJECTを破棄
    Set objFSO = Nothing
    ' 処理完了(結果表示)
    MsgBox "処理が完了しました。" & vbCr & vbCr & _
        "フォルダ数=" & g_cntPATH & vbCr & _
        "ファイル数=" & g_cntFILE, vbInformation
End Sub

'*******************************************************************************
'   フォルダ単位のサブ処理(再帰動作,引数はFile-Object,行,カラム)
'*******************************************************************************
Private Sub SEARCH_SUB_FOLDER(ByVal objPATH As Folder, _
                              ByRef GYO As Long, _
                              ByVal COL As Long)
    Dim objPATH2 As Folder
    Dim objFILE As File

    ' 現在フォルダをシート上に表示
    g_cntPATH = g_cntPATH + 1                   ' 参照フォルダ数を加算
    GYO = GYO + 1                               ' 行を加算
    COL = COL + 1                               ' カラムを加算
    Cells(GYO, COL).Value = "[" & objPATH.Name & "]"

    ' ■先ずサブフォルダを探索するループ処理
    For Each objPATH2 In objPATH.SubFolders
        ' フォルダ単位のサブ処理(再帰呼び出し)
        Call SEARCH_SUB_FOLDER(objPATH2, GYO, COL)
    Next objPATH2

    ' ■本フォルダの各ファイルをシート上に表示するループ処理
    COL = COL + 1                               ' カラムを加算
    For Each objFILE In objPATH.Files
        g_cntFILE = g_cntFILE + 1               ' 参照ファイル数
        GYO = GYO + 1                           ' 行を加算
        With objFILE
            ' ファイル名+(最終更新日時+ファイルサイズ)
            Cells(GYO, COL).Value = .Name & _
                " (" & .DateLastModified & " " & _
                Format(.Size, "#,##0") & "Bytes)"
        End With
    Next objFILE
    ' 参照OBJECTを破棄
    Set objPATH = Nothing
End Sub

'-----------------------------<< End of Source >>-------------------------------

(ここをクリックすると、このサンプルがダウンロードできます)
これを実行すると、このような感じになります。
FSOでファイル一覧を作成したところ
見てお解りのように、フォルダ名にはカギ括弧が付いて青字で表示されますが、この青字は「条件付き書式」の処理です。フォルダの上下関係がシート上の列で分かるようにしてあります。 ファイル名の右の括弧内は、最終更新日時とファイルサイズです。
ご覧のように、コメントと折り返しを除いてしまえば30と数行のマクロでこれだけの機能が実現できてしまうのです。 Folderオブジェクトを「値渡し(ByVal)で渡す替わりに、サブ処理側ではGetFolderメソッドを発行し直さないため、結構高速に動作すると思います。

なぜ、2つのプロシージャに分かれているのでしょう。
処理のプロシージャが2つに分かれており、SEARCH_FOLDERがメイン処理です。特に起動ボタンなどは設けていないのでツールバーの「マクロ」から起動させて下さい。
先ず、「フォルダの参照」が表示されて、ここで処理のルートフォルダを指定しますが、この「フォルダの参照」を表示させる機能は、別モジュールである「modFolderPicker1.bas」にあるプロシージャ「FolderDialog」を呼び出しています。 この機能については、「ダウンロード」にある「フォルダの参照」で説明しています。
さて、SEARCH_FOLDERではルートとなるフォルダを指定した後は、それを引数にしてSEARCH_SUB_FOLDERを呼び出すだけになっています。 これだけでどうして配下の全サブフォルダを含めて一覧が取得できるのでしょうか、と疑問になると思います。
これはVBAの基本的な機能の中の「再帰処理」を利用しているものです。「再帰処理」とは、記述上での1つのプロシージャが終了していない内に「自分自身」を呼び出してしまう処理方法のことですが、 この時呼び出される「自分自身」はメモリ上では「別プロシージャ扱い」で動作するものです。ここでは処理の都合で引数の渡し方を「参照渡し(ByRef)「値渡し(ByVal)を使い分けてやることで、 呼び出し後の動作を区別することができます。
一般のサブ処理の呼び出しに引数を加える場合は、「参照渡し(ByRef)「値渡し(ByVal)の指定をしないことがほとんどですが、指定がない場合は「参照渡し(ByRef)として動作し、 呼び出し元と呼び出し先は同じメモリ位置に置かれた変数を参照します。つまり、呼び出し先で引数にある変数を書き換えると、呼び出し元に戻った後も書き換えられた状態で動作するわけです。
呼び出し元のプロシージャから見て、引数に与えた変数が勝手に書き換えられては困る場合は、「値渡し(ByVal)にすることで、変数はコピーされて渡されるわけです。
今回の処理では、シート上の行を指し示す引数については、全体でカウントするので「参照渡し(ByRef)のまま利用し、それ以外は再帰動作で書き換わると不都合なので「値渡し(ByVal)にするわけです。
この「再帰処理」の機能によりSEARCH_SUB_FOLDERは、フォルダ構成上の階層の数と同じ個数がメモリ上に生成されて分離動作するわけです。 ですから、メモリ上で余分なことを行なわないように最小限の記述に止める工夫が必要です。

「ダウンロード」に「フォルダ一覧」がありますが、これもFileSystemObject(FSO)を用いています。

では、ついでですが....
「ダウンロード」の「フォルダ一覧」は、このような「再帰的」な処理を行なっていますが、ここでの記述とは大きく異なります。
このページで「フォルダ一覧」のコードの解説はできませんが、この前のサンプルにフォルダやファイルの「つなぎ線」を付け加えてみましょう。

'*******************************************************************************
'   FSOでフォルダ内のファイル一覧を取得しシート上に展開する(含むサブフォルダ)
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
' [参照設定]
'   ・Microsoft Scripting Runtime
'*******************************************************************************
Option Explicit
' GetSystemTimeで使用する構造体
Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
' ■システム時刻取得
Private Declare Sub GetSystemTime Lib "KERNEL32.dll" _
    (lpSystemTime As SYSTEMTIME)
Private Const cnsLINE1 = "│"                   ' 表示接続線@
Private Const cnsLINE2 = "├─"                 ' 〃A
Private Const cnsLINE3 = "└─"                 ' 〃B
Private g_cntFILE As Long                       ' ファイル数
Private g_cntPATH As Long                       ' フォルダ数
Private g_tblSwLine(1 To 256) As Byte           ' つなぎ線有無FLG
Private g_tblLastGYO(1 To 256) As Long          ' カラム別最終フォルダ行
Private g_MAXCOL As Long                        ' 最終カラム

'*******************************************************************************
'   全体処理(ルートフォルダを指定して探索を開始)
'*******************************************************************************
Sub SEARCH_FOLDER2()
    Dim objFSO As FileSystemObject
    Dim strPATHNAME As String
    Dim crnTIME1 As Currency                        ' 処理時間
    Dim crnTIME2 As Currency                        ' 処理時間

    ' ルートとなるフォルダの指定(※modFolderPicker1.bas)
    strPATHNAME = modFolderPicker1.FolderDialog( _
        "ルートフォルダを指定して下さい。", True)
    If strPATHNAME = "" Then Exit Sub
    ' 処理開始
    Cells.ClearContents
    ' 処理開始時刻の受領
    crnTIME1 = FP_GET_SYSTIME                       ' 開始時刻
    Set objFSO = New FileSystemObject           ' FSO
    ' ルートフォルダから探索開始
    Call SEARCH_SUB_FOLDER2(objFSO.GetFolder(strPATHNAME), 0, 0)
    ' 参照OBJECTを破棄
    Set objFSO = Nothing
    ' 処理時間の算出
    Application.DisplayCommentIndicator = xlCommentIndicatorOnly
    crnTIME2 = FP_GET_SYSTIME - crnTIME1            ' 終了時刻-開始時刻
    ' 処理完了(結果表示)
    MsgBox "処理が完了しました。" & vbCr & vbCr & _
        "フォルダ数=" & Format(g_cntPATH, "#,##0") & _
        ", ファイル数=" & Format(g_cntFILE, "#,##0") & vbCr & _
        "(処理時間=" & Format(crnTIME2, "#,##0.000") & "秒)", vbInformation
End Sub

'*******************************************************************************
'   フォルダ単位のサブ処理(再帰動作,引数はFile-Object,行,カラム)
'*******************************************************************************
Private Sub SEARCH_SUB_FOLDER2(ByVal objPATH As Folder, _
                               ByRef GYO As Long, _
                               ByVal COL As Long)
    Dim objPATH2 As Folder
    Dim objFILE As File
    Dim COL2 As Long
    Dim COL3 As Long
    Dim GYO2 As Long
    Dim cntFILE2 As Long

    ' 現在フォルダをシート上に表示
    g_cntPATH = g_cntPATH + 1                   ' 参照フォルダ数を加算
    GYO = GYO + 1                               ' 行を加算
    ' つなぎ線処理(手前のカラムに縦線を引く)
    COL2 = 1
    Do While COL2 < COL
        If g_tblSwLine(COL2) = 1 Then
            Cells(GYO, COL2).Value = cnsLINE1                   ' │
        End If
        COL2 = COL2 + 1
    Loop
    If COL >= 1 Then
        If g_tblLastGYO(COL) <> 0 Then
            ' 直前のフォルダから本行前まで縦線を引く
            Cells(g_tblLastGYO(COL), COL).Value = cnsLINE2      ' ├─
            GYO2 = g_tblLastGYO(COL) + 1
            Do While GYO2 < GYO
                Cells(GYO2, COL).Value = cnsLINE1               ' │
                GYO2 = GYO2 + 1
            Loop
        End If
        Cells(GYO, COL).Value = cnsLINE3                        ' └─
        g_tblLastGYO(COL) = GYO
        g_tblSwLine(COL) = 0
    End If
    COL = COL + 1                               ' カラムを加算
    Cells(GYO, COL).Value = "[" & objPATH.Name & "]"
    ' つなぎ線処理(要縦線判定スイッチセット)
    g_tblSwLine(COL) = 1
    If g_MAXCOL < COL Then g_MAXCOL = COL
    For COL2 = COL To g_MAXCOL
        g_tblLastGYO(COL2) = 0
    Next COL2

    ' ■先ずサブフォルダを探索するループ処理
    For Each objPATH2 In objPATH.SubFolders
        ' フォルダ単位のサブ処理(再帰呼び出し)
        Call SEARCH_SUB_FOLDER2(objPATH2, GYO, COL)
    Next objPATH2

    ' ■本フォルダの各ファイルをシート上に表示するループ処理
    COL2 = COL
    COL = COL + 1                               ' カラムを加算
    cntFILE2 = g_cntFILE
    For Each objFILE In objPATH.Files
        ' つなぎ線処理(直前のフォルダから本行前まで縦線を引く)
        If g_tblLastGYO(COL2) <> 0 Then
            Cells(g_tblLastGYO(COL2), COL2).Value = cnsLINE2    ' ├─
            GYO2 = g_tblLastGYO(COL2) + 1
            Do While GYO2 <= GYO
                Cells(GYO2, COL2).Value = cnsLINE1              ' │
                GYO2 = GYO2 + 1
            Loop
            g_tblLastGYO(COL2) = 0
        End If
        g_cntFILE = g_cntFILE + 1               ' 参照ファイル数を加算
        GYO = GYO + 1                           ' 行を加算
        ' つなぎ線処理(手前のカラムに縦線を引く)
        COL3 = 1
        Do While COL3 < COL2
            If g_tblSwLine(COL3) = 1 Then
                Cells(GYO, COL3).Value = cnsLINE1               ' │
            End If
            COL3 = COL3 + 1
        Loop
        With objFILE
            ' ファイル名+(最終更新日時+ファイルサイズ)
            Cells(GYO, COL2).Value = cnsLINE2                   ' ├─
            Cells(GYO, COL).Value = .Name & _
                " (" & .DateLastModified & " " & _
                Format(.Size, "#,##0") & "Bytes)"
        End With
    Next objFILE
    If g_cntFILE > cntFILE2 Then
        Cells(GYO, COL2).Value = cnsLINE3                       ' └─
    End If
    ' 参照OBJECTを破棄
    Set objPATH = Nothing
End Sub

'*******************************************************************************
'   システム時刻の取得(ミリ秒単位)
'*******************************************************************************
Private Function FP_GET_SYSTIME() As Currency
    Dim SysTime As SYSTEMTIME                   ' 開始時刻

    ' 処理時間の算出(API)
    Call GetSystemTime(SysTime)
    ' 秒単位(換算値)に変換
    With SysTime
        FP_GET_SYSTIME = CCur(.wHour) * 3600@ + (CCur(.wMinute) * 60@) + _
            CCur(.wSecond) + (CCur(.wMilliseconds) / 1000@)
    End With
End Function

'-----------------------------<< End of Source >>-------------------------------

(ここをクリックすると、このサンプルがダウンロードできます)
これを実行すると、このような感じになります。
FSOでファイル一覧を作成したところ
いかがでしょうか。表示上の機能は、「フォルダ一覧」とほとんど同じですが、「フォルダ一覧」の方は色使いやリンク起動機能などがあって、 実はこちらのコードの方がはるかに速く動作します。