List files in directories and subdirectories

[Barley Man]

I have copied an example macro from a knowledge base article. It ALMOST does
the job I need but not quite.

It list all the files in a specific directory but I also need to list all
the files in that directory AND those in the subdirectories below it. (It
also need to include the full path address for anyfiles in subdirectories, it
already does thios for the main directory but I want to be sure it incldes
the full path for those 'below' it)

I thought I only need to add the line

" .SearchSubFolders = True"

....... but that doesn't do it.

Any advice how I modify the code below to give what I need?

***********************************************


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

Dim x As String, MyName As String
Dim i As Integer
Dim Response As Integer, TotalFiles As Integer

On Error Resume Next

Folder:

' Prompt the user for the folder to list.
x = InputBox(Prompt:="What folder do you want to list?" & vbCr & vbCr _
& "For example: C:\My Documents", _
Default:=Options.DefaultFilePath(wdDocumentsPath))

If x = "" Or x = " " Then
If MsgBox("Either you did not type a folder name correctly" _
& vbCr & "or you clicked Cancel. Do you want to quit?" _
& vbCr & vbCr & _
"If you want to type a folder name, click No." & vbCr & _
"If you want to quit, click Yes.", vbYesNo) = vbYes Then
Exit Sub
Else
GoTo Folder
End If
End If

' Test if folder exists.
If Dir(x, vbDirectory) = "" Then
MsgBox "The folder does not exist. Please try again."
GoTo Folder
End If

' Search the specified folder for files
' and type the listing in the document.
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeAllFiles
' Change the .FileType to the type of files you are looking for;
' for example, the following line finds all files:
' .FileType = msoFileTypeAllFiles
' .FileType = msoFileTypeOfficeFiles
.LookIn = x
.Execute
TotalFiles = .FoundFiles.Count
If TotalFiles = 0 Then
MsgBox ("There are no files in the folder!" & _
"Please type another folder to list.")
GoTo Folder
End If

' Create a new document for the file listing.
Application.Documents.Add
ActiveDocument.ActiveWindow.View = wdPrintView

' Set tabs.
With Selection.ParagraphFormat.TabStops
.Add _
Position:=InchesToPoints(3), _
Alignment:=wdAlignTabLeft, _
Leader:=wdTabLeaderSpaces
.Add _
Position:=InchesToPoints(4), _
Alignment:=wdAlignTabLeft, _
Leader:=wdTabLeaderSpaces
End With

' 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!" & vbLf
Selection.Font.Underline = wdUnderlineSingle
Selection.TypeText vbLf & "File Name" & vbTab & "File Size" _
& vbTab & "File Date/Time" & vbLf & vbLf
Selection.Font.Underline = wdUnderlineNone
For i = 1 To TotalFiles
MyName = .FoundFiles(i)
Selection.TypeText MyName & vbTab & FileLen(MyName) _
& vbTab & FileDateTime(MyName) & vbLf
Next i

' Type the total number of files found.
Selection.TypeText vbLf & "Total files in folder = " & TotalFiles & _
" files."
End With

If MsgBox("Do you want to print this folder list?", vbYesNo) = vbYes Then
Application.ActiveDocument.PrintOut
End If

If MsgBox("Do you want to list another folder?", vbYesNo) = vbYes Then
GoTo Folder
End If

End Sub

 

[Helmut Weber]

Hi Barley,

google for "Dirdiver".

Greetings from Bavaria, Germany
Helmut Weber, MVP WordVBA
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000