I found that a recursive Dir routine was the quickest:
Function FindFiles(strPath As String, _
strSearch As String, _
Optional lFileCount As Long = 0, _
Optional lDirCount As Long = 0) As String()
'will produce a 1-based 1-D array with all the found filepaths
'will add the paths first to a collection and transfer to an
'array once we know how many paths there are
'---------------------------------------------------------------
'adapted from the MS example:
'
http://support.microsoft.com/default.aspx?scid=kb;en-us;185476
'---------------------------------------------------------------
'will list all the files in the supplied folder and it's
'subfolders that fit the strSearch criteria
'lFileCount and lDirCount will always have to start as 0
'use for example like this:
'Dim arr
'arr = FindFiles("C:\TestFolder", "*.xls")
'---------------------------------------------------------------
Dim strFileName As String 'Walking strFileName variable.
Dim strDirName As String 'SubDirectory Name.
Dim arrDirNames() As String 'Buffer for directory name entries.
Dim nDir As Long 'Number of directories in this strPath.
Dim i As Long 'For-loop counter.
Static strStartDirName As String
Static collFiles As Collection
Dim arrFinal
On Error GoTo sysFileERR
If Right(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
If lFileCount = 0 And lDirCount = 0 Then
strStartDirName = strPath
Set collFiles = New Collection
End If
'Search for subdirectories.
nDir = 0
ReDim arrDirNames(nDir)
strDirName = Dir(strPath, vbDirectory Or vbHidden Or vbArchive Or
vbReadOnly _
Or vbSystem) 'Even if hidden, and so
on.
Do While Len(strDirName) > 0
'Ignore the current and encompassing directories.
If (strDirName <> ".") And (strDirName <> "..") Then
'Check for directory with bitwise comparison.
If GetAttr(strPath & strDirName) And vbDirectory Then
arrDirNames(nDir) = strDirName
lDirCount = lDirCount + 1
nDir = nDir + 1
ReDim Preserve arrDirNames(nDir)
End If 'directories.
sysFileERRCont:
End If
strDirName = Dir() 'Get next subdirectory.
Loop
'Search through this directory
strFileName = Dir(strPath & strSearch, _
vbNormal Or _
vbHidden Or _
vbSystem Or _
vbReadOnly Or _
vbArchive)
While Len(strFileName) <> 0
lFileCount = lFileCount + 1
collFiles.Add Item:=strPath & strFileName, KEY:=CStr(lFileCount)
strFileName = Dir() 'Get next file.
Wend
'If there are sub-directories..
If nDir > 0 Then
'Recursively walk into them
For i = 0 To nDir - 1
FindFiles strPath & arrDirNames(i) & "\", _
strSearch, _
bSort, _
lFileCount, _
lDirCount
Next
End If
If strPath & arrDirNames(i) = strStartDirName Then
'change the collection to an array
'---------------------------------
ReDim arrFinal(1 To lFileCount) As String
For i = 1 To lFileCount
arrFinal(i) = collFiles(i)
Next
FindFiles = arrFinal
End If
ABORTFUNCTION:
Exit Function
sysFileERR:
If Right(strDirName, 4) = ".sys" Then
Resume sysFileERRCont 'Known issue with pagefile.sys
Else
Resume ABORTFUNCTION
End If
End Function
RBS
