Получить список всех файлов в каталоге и его подкаталогах

    Sub Files_and_Folders()
 
        'выясняем количество файлов и папок в папке ...
        Dim FolderPath As String
        FolderPath = "C:\"
 
        Dim FileSystemObject As Object
        FileSystemObject = CreateObject("Scripting.FileSystemObject")
        Dim f As Object
        f = FileSystemObject.GetFolder(FolderPath)
 
        Dim fld As Object
        Dim Папки As Integer
        For Each fld In f.SubFolders
            Папки = Папки + 1
        Next
 
        Dim fl As Object
        Dim Файлы As Integer
        For Each fl In f.Files
            Файлы = Файлы + 1
        Next
 
 
        FileSystemObject = Nothing
        f = Nothing
 
        MsgBox("Папки: " & Папки & Chr(13) & "Файлы: " & Файлы)
 
    End Sub

     '::: Код VBScript
 
     StartFolder="D:\Off_VBA\Çàäà÷è"    ' ×òî ñêàíèðîâàòü
     Fout="C:\list.txt"                 ' Êóäà çàïèñàòü ðåçóëüòàò
     '::: Íà÷àëî
     Set aFso =CreateObject("Scripting.FileSystemObject")
     Set aDict=CreateObject("Scripting.Dictionary")
     Set sFld=aFso.GetFolder(StartFolder)
     Scan_Fold sFld
     Set txtOut = aFSO.CreateTextFile(Fout)
     n=aDict.Count 
     aKeys=aDict.Keys
     aItems=aDict.Items 
     For i=0 to n-1
         txtOut.WriteLine aKeys(i) & " " & aItems(i)
     Next
     txtOut.Close
     MsgBox "OK!" 
 
     '::: Ïîäïðîãðàììû
     
Sub Scan_Fold(aFolder)  '::: Ñêàíèðîâàòü ïàïêó
    For each fld in aFolder.SubFolders
        Set aFil=Fld.Files
        Scan_Files aFil
        Scan_Fold fld 
    Next
End Sub
 
Sub Scan_Files(Fils)    '::: Îáðàáîòàòü ôàéëû ïàïêè
    for each fil in Fils
        dFil=fil.DateCreated
        tmp=Left(Cstr(dFil),10)
        if aDict.Exists(tmp) then
           n=aDict.Item(tmp)+1
           aDict.Remove tmp
           aDict.add tmp,n
        else
           aDict.add tmp,1
        end if
    next
End Sub