WD2000: Sample Macro to List All Files in a Folder

Sub FolderList()
'
' Example Macro to list the files contained in a folder.
'

Dim x, fs
Dim I As Integer
Dim y As Integer
Dim Folder, MyName, TotalFiles, Response, PrintResponse, AgainResponse

On Error Resume Next

Folder:
' Prompt the user for the folder to list.
x = InputBox("What folder do you want to list?" & Chr$(13) & Chr$(13) _
   & "For example: C:\My Documents")

If x = "" Or x = " " Then
    Response = MsgBox("Either you did not type a folder name correctly" _
    & Chr$(13) & "or you clicked Cancel. Do you want to quit?" _
    & Chr$(13) & Chr$(13) & _
    "If you want to type a folder name, click No." & Chr$(13) & _
    "If you want to quit, click Yes.", vbYesNo)

        If Response = "6" Then
            End
        Else
            GoTo Folder
        End If
Else

' Test if folder exists.
Set Folder = CreateObject("Scripting.filesystemobject")
If Folder.folderexists(x) = "True" Then

' Search the specified folder for files and type the listing in the ' document.
    
    With Application.FileSearch
        Set fs = Application.FileSearch
        fs.NewSearch
            With fs.PropertyTests
                .Add Name:="Files of Type", _
                Condition:=msoConditionFileTypeAllFiles, _
                Connector:=msoConnectorOr
            End With
        .LookIn = x
        .Execute
        TotalFiles = .FoundFiles.Count
        
                If TotalFiles <> 0 Then
                
                    ' Create a new document for the file listing.
                    Application.Documents.Add
                    ActiveDocument.ActiveWindow.View = wdPrintView
                    
                    ' Set tabs.
                    Selection.WholeStory
                    Selection.ParagraphFormat.TabStops.ClearAll
                    ActiveDocument.DefaultTabStop = InchesToPoints(0.5)
                    Selection.ParagraphFormat.TabStops.Add _
                       Position:=InchesToPoints(3), _
                       Alignment:=wdAlignTabLeft, _
                       Leader:=wdTabLeaderSpaces
                    Selection.ParagraphFormat.TabStops.Add _
                       Position:=InchesToPoints(4), _
                       Alignment:=wdAlignTabLeft, _
                       Leader:=wdTabLeaderSpaces
                    
                    ' Type the file list headings.
                    Selection.TypeText "File Listing of the "
                    
                    With Selection.Font
                        .AllCaps = True
                        .Bold = True
                    End With
                    Selection.TypeText x
                    With Selection.Font
                        .AllCaps = False
                        .Bold = False
                    End With
                    
                    Selection.TypeText " folder!" & Chr$(13)
                    
                    With Selection.Font
                        .Underline = wdUnderlineSingle
                    End With
                    With Selection
                        .TypeText Chr$(13)
                        .TypeText "File Name" & vbTab & "File Size" _
                           & vbTab & "File Date/Time" & Chr$(13)
                        .TypeText Chr$(13)
                    End With
                        With Selection.Font
                        .Underline = wdUnderlineNone
                    End With
        
                Else
                    MsgBox ("There are no files in the folder!" & _
                       "Please type another folder to list.")
                    GoTo Folder
                End If
        
        For I = 1 To TotalFiles
            MyName = .FoundFiles.Item(I)
            .FileName = MyName
            Selection.TypeText .FileName & vbTab & FileLen(MyName) _
               & vbTab & FileDateTime(MyName) & Chr$(13)
        Next I
        
        ' Type the total number of files found.
        Selection.TypeText Chr$(13)
        Selection.TypeText "Total files in folder = " & TotalFiles & _
           " files."
    
    End With
    
    Else
        MsgBox "The folder does not exist. Please try again."
        GoTo Folder
    End If
End If

PrintResponse = MsgBox("Do you want to print this folder list?", vbYesNo)
    If PrintResponse = "6" Then
        Application.ActiveDocument.PrintOut
    End If
    
AgainResponse = MsgBox("Do you want to list another folder?", vbYesNo)
    If AgainResponse = "6" Then
        GoTo Folder
    Else
        End
    End If

End:
End Sub