Снова поиск

Public resFile As Object
Public Const resFileSpec = "c:\ListFiles.txt"

Sub Main()
Dim fsObj As Object
Const sourceDir = "c:\temp"

Set fsObj = CreateObject("Scripting.FileSystemObject")
If fsObj.FolderExists(sourceDir) = True Then
    Set resFile = fsObj.OpenTextFile(resFileSpec, 2, True)
    Call ViewFolder(sourceDir)
    resFile.Close
    MsgBox "Готово", vbInformation, "Отчёт"
Else
    MsgBox "Отсутствует каталог-источник: " & UCase(sourceDir), vbCritical, "Ошибка"
End If
Set fsObj = Nothing
End Sub

Private Function ViewFolder(dirSource As String)
Dim fsObj As Object, pntDir As Object, curSubDir As Object

Set fsObj = CreateObject("Scripting.FileSystemObject")
Set pntDir = fsObj.GetFolder(dirSource)
resFile.WriteLine (UCase(dirSource))
Call Enum_Files(dirSource)
resFile.WriteLine ("")
For Each curSubDir In pntDir.SubFolders
    Call ViewFolder(curSubDir.Path)
Next curSubDir
Set pntDir = Nothing
Set fsObj = Nothing
End Function

Private Function Enum_Files(dirSource As String)
Dim fsObj As Object, pntDir As Object, curFile As Object

Set fsObj = CreateObject("Scripting.FileSystemObject")
Set pntDir = fsObj.GetFolder(dirSource)
For Each curFile In pntDir.Files
    resFile.WriteLine (curFile.Name)
Next curFile
Set pntDir = Nothing
Set fsObj = Nothing
End Function