Option Explicit

'コマンドボタンをクリックしました
Private Sub Command1_Click()
    Dim cleItems        As New Collection
    Dim x               As Variant
    Dim lngFileCount    As Long
    Dim lngFolderCount  As Long
    Dim iSecond1 As Integer
    Dim iSecond2 As Integer
    
    'リストボックスをクリアにします
    List1.Clear
    List1.Refresh
    
    'コマンドボタンのイベントを無効にします
    Command1.Enabled = False
    
    'ファイルとフォルダを列挙します
    Set cleItems = GetEnumFiles("C:\Windows\Favorites")
    'cleItemsの内容をすべて吐き出します
    For Each x In cleItems
        'ファイルかフォルダかを識別します
        If Right(x, 1) = "\" Then
            x = "folder: " & x
            lngFolderCount = lngFolderCount + 1
        Else
            x = "file: " & x
            lngFileCount = lngFileCount + 1
        End If
        'リストボックスにアイテムを追加します
        List1.AddItem x
        
        '4秒おきにリストボックスを更新します
        iSecond1 = Second(Time) ¥ 4
        If Not (iSecond1 = iSecond2) Then
            iSecond2 = iSecond1
            'リストボックスを下にスクロールさせます
            List1.ListIndex = List1.ListCount - 1
            List1.Refresh
        End If
    Next
    
    '結果をラベルに表示します
    Label1.Caption = "ファイル数: " & lngFileCount & vbCrLf _
            & "フォルダ数: " & lngFolderCount
    
    'コマンドボタンのイベントを有効にします
    Command1.Enabled = True
    
End Sub

'指定したフォルダのフルパスから
'ファイルとフォルダを列挙して
'コレクションクラスで返します
Function GetEnumFiles(ByVal strDirPath As String) As Collection
    Dim strDirItem      As String
    Dim strDirItemFull  As String
    Dim strFolder       As String
    Dim cleFolders      As New Collection
    Dim cleEnumItems    As New Collection
    
    'フォルダなので最後の文字列が"\"でないときは
    ' "\" を付加します
    If Not (Right(strDirPath, 1) = "\") Then
        strFolder = strDirPath & "\"
    End If
    
    'フォルダコレクションに
    'フォルダのフルパスを格納して
    '検索対象にすることで始まります
    cleFolders.Add strFolder
    
    '検索ループを開始します
    Do
        'Dirで取得したファイルまたはフォルダが
        'これ以上ないときにヌルを返すので
        'ここに入れる(ループに入り始めるときも含)
        If strDirItem = "" Then
            'フォルダのフルパスを格納するコレクションに
            'アイテムが入っているなら
            'コレクションの先頭のアイテムを取得したあと
            '必要なくなるので先頭のアイテムを削除します
            If cleFolders.Count > 0 Then
                strFolder = cleFolders.Item(1)
                cleFolders.Remove 1
            Else
                'アイテムがないときはヌルを格納します
                strFolder = ""
            End If
            'cleFoldersが空か、
            '何かの原因でcleFoldersに
            '空のデータが格納されたときのために
            'strFolder="" のとき処理を終了するようにする
            If strFolder = "" Then
                'Doループを抜けるときに
                '変なところに寄り道しないように
                '変数の内容を消去します
                strDirItem = ""
                Exit Do
            Else
                'Dir関数により指定のフォルダの
                'ファイルとフォルダを列挙します
                strDirItem = Dir(strFolder, vbDirectory)
                'つなぎ合わせてフルパスを格納します
                'strFolderの最後の文字列が"\"なので
                '付加する必要はなし
                strDirItemFull = strFolder & strDirItem
            End If
        Else
            '次のファイルまたはフォルダを列挙します
            strDirItem = Dir
            'つなぎ合わせてフルパスにします
            strDirItemFull = strFolder & strDirItem
        End If
        '指定のフォルダの親のフォルダを示す"."、".."は
        '対象外なのではじきます
        If Not (strDirItem = "." Or strDirItem = ".." Or strDirItem = "") Then
            'ファイルかフォルダかを確認をとります
            If CBool(GetAttr(strDirItemFull) And vbDirectory) = True Then
                'フォルダなので最後の文字列が"\"でないときは
                ' "\" を付加します
                If Not (Right(strDirItemFull, 1) = "\") Then
                    strDirItemFull = strDirItemFull & "\"
                End If
                cleFolders.Add strDirItemFull
            End If
            'ファイルまたはフォルダの
            'フルパスを格納します
            'フォルダのフルパスかどうかの確認は
            '最後の文字列が "\" かどうかを調べてください
            cleEnumItems.Add strDirItemFull
        End If
    Loop
    
    '結果を格納します
    '配列で扱いたいときは
    'ここでFor Eachを使い、
    '配列に格納しなおして
    'GetEnumFilesをVariant型の関数にして
    '格納するという方法もあります
    Set GetEnumFiles = cleEnumItems
    
End Function