see
http://msdn2.microsoft.com/en-us/library/aa164475(office.10).aspx
Sub TestGetFiles()
' Call to test GetFiles function.
Dim dctDict As Dictionary
Dim varItem As Variant
' Create new dictionary.
Set dctDict = New Dictionary
' Call recursively, return files into Dictionary object.
If GetFiles("p:\chat", dctDict, True) Then
' Print items in dictionary.
For Each varItem In dctDict
Debug.Print varItem
Next
End If
End Sub
Function GetFiles(strPath As String, _
dctDict As Dictionary, _
Optional blnRecursive As Boolean) As Boolean
' This procedure returns all the files in a directory into
' a Dictionary object. If called recursively, it also returns
' all files in subfolders.
Dim fsoSysObj As FileSystemObject
Dim fdrFolder As Folder
Dim fdrSubFolder As Folder
Dim filFile As File
' Return new FileSystemObject.
Set fsoSysObj = New FileSystemObject
On Error Resume Next
' Get folder.
Set fdrFolder = fsoSysObj.GetFolder(strPath)
If Err <> 0 Then
' Incorrect path.
GetFiles = False
GoTo GetFiles_End
End If
On Error GoTo 0
' Loop through Files collection, adding to dictionary.
For Each filFile In fdrFolder.Files
dctDict.Add filFile.Path, filFile.Path
Next filFile
' If Recursive flag is true, call recursively.
If blnRecursive Then
For Each fdrSubFolder In fdrFolder.SubFolders
GetFiles fdrSubFolder.Path, dctDict, True
Next fdrSubFolder
End If
' Return True if no error occurred.
GetFiles = True
GetFiles_End:
Exit Function
End Function