ExcelBanter - API To Find File

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

"Frank" wrote in message
...
I am using the system Application.FileSearch but this can take a long time
to
find and write to a db table, I was wondering if there was an API function
that would find files quicker.
any help would be much appreciated.
Frank.