'=================================================================
'===== Recursive file search VB6 by Vitaloverdose 2008 ===========
'=================================================================
Public Function fRecersiveSearch(SearchDir As String, bFullpath As Boolean, Optional FoundTxt As String, Optional LabFound As Label) As String()
Dim FileList() As String
Dim DirList() As String
Dim nDirs As Long
Dim nFiles As Long
Dim fObj As String
Dim ObjPath As String
Dim nCurrent As Long
MsgBox ("fRecersiveSearch")
On Error Resume Next
ReDim Preserve FileList(nCurrent)
ReDim Preserve DirList(nCurrent)
If Right$(SearchDir, 1) <> "\" Then
SearchDir = SearchDir & "\"
End If
DirList(nCurrent) = SearchDir
While nCurrent <> UBound(DirList) + 1
SearchDir = DirList(nCurrent)
fObj = Dir$(SearchDir & "*.*", vbDirectory)
While Len(fObj)
If (fObj <> "..") And (fObj <> ".") Then
ObjPath = SearchDir & fObj
If GetAttr(ObjPath) And vbDirectory Then
ReDim Preserve DirList(nDirs)
DirList(nDirs) = ObjPath & "\"
nDirs = nDirs + 1
Else
ReDim Preserve FileList(nFiles)
If bFullpath = True Then
FileList(nFiles) = ObjPath
Else
FileList(nFiles) = GetfName(ObjPath)
End If
nFiles = nFiles + 1
End If
End If
fObj = Dir$
Wend
nCurrent = nCurrent + 1
Wend
fRecersiveSearch = FileList
End Function
Sunday, 2 November 2008
Subscribe to:
Posts (Atom)