Option Explicit
 
Dim FSO As New Scripting.FileSystemObject
Dim FDR As Scripting.Drive
Dim FOL As Scripting.Folder
Dim FIL As Scripting.File
Dim FST As Scripting.TextStream
 
Sub main()
Set FST = FSO.CreateTextFile("D:\FILELIST.txt", True)
Set FDR = FSO.GetDrive("D:\")
Call unter(FDR.RootFolder)
End Sub
 
Sub unter(F As Scripting.Folder)
Stop
For Each FIL In F.Files
    If FIL.Attributes = 32 Then
        FST.WriteLine (FIL.Path)
    End If
Next FIL
For Each FOL In F.SubFolders
    Call unter(FOL)
Next FOL
 
End Sub