Cheer up, what you're asking for can be quite a task. A "recursive" function is a function that calls -itself-. Its sorta like spelling the word "bananna" .. easy enuff to do, you just have to know when to -stop- ....
You dont have to call the "File System Object", you can do it all from source code.
included in this post is an entire *module* of code. Copy/paste it into a VBA code module. To do this, in VBA, click "Insert", then "Module". In the blank screen that appears, copy all the source code posted below.
The module this code creates will search any folder you specify, for a file of a certain type ("*.dwg". "*.xls", etc) and will tunnel down through all the subfolders underneath.
When it finds that type of file, it jumps down to the last routine, called "DoSomethingWithFile". here, you can put your own code to do something with the NAME of the file found. Right now, all it does is Debug.Print out the full path/filename of the file it finds. You can put your own code in here, and make this module do your bidding.
Code:
Private Const vbDot = 46
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const vbBackslash = "\"
Private Const ALL_FILES = "*.*"
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" _
Alias "FindNextFileA" (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function PathMatchSpec Lib "shlwapi" _
Alias "PathMatchSpecW" (ByVal pszFileParam As Long, _
ByVal pszSpec As Long) As Long
Dim sFileExt As String
Dim sFileRoot As String
Public Sub FindAllFiles(FileType As String, StartPath As String)
' recursively searches a passed path for files of a given type
' returns a safearray of the fully qualified pathspecs
' FileType: a wildcard string of the file extension, ie; "*.dwg" or "*.xls"
sFileRoot = QualifyPath(StartPath) 'start path
sFileExt = FileType 'file type of interest
Call SearchForFiles(sFileRoot)
End Sub
Private Sub SearchForFiles(sRoot As String)
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
hFile = FindFirstFile(sRoot & ALL_FILES, WFD)
If hFile <> INVALID_HANDLE_VALUE Then
Do
'if a folder, and recurse specified, call method again
If (WFD.dwFileAttributes And vbDirectory) Then
If Asc(WFD.cFileName) <> vbDot Then
SearchForFiles sRoot & TrimNull(WFD.cFileName) & vbBackslash
End If
Else
'must be a file..
If MatchSpec(WFD.cFileName, sFileExt) Then
DoSomethingWithFile sRoot & TrimNull(WFD.cFileName)
End If 'If MatchSpec
End If 'If WFD.dwFileAttributes
Loop While FindNextFile(hFile, WFD)
End If 'If hFile
Call FindClose(hFile)
End Sub
Private Function QualifyPath(sPath As String) As String
' formats passed path string to be used in recursive API search
If Right$(sPath, 1) <> vbBackslash Then
QualifyPath = sPath & vbBackslash
Else
QualifyPath = sPath
End If
End Function
Private Function TrimNull(startstr As String) As String
' trims NULL char (ascii 0) from strings returned by API calls
TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
End Function
Private Function MatchSpec(sFile As String, sSpec As String) As Boolean
' uses API version of the "LIKE" command
MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec))
End Function
Private Sub DoSomethingWithFile(FoundFileName As String)
' use this routine to do something with each file found
' we'll do nothing but print out the filename found
Dim FoundName As String: FoundName = FoundFileName
Debug.Print FoundName
End Sub
I don't have a CLUE...
Reply With Quote
