''by PrismP @ http://social.msdn.microsoft.com/Forums/en-US/isvvba/thread/a450830d-4fc3-4f4e-aee2-03f7994369d6
'http://social.msdn.microsoft.com/profile/prizmp/?type=forum&referrer=http://social.msdn.microsoft.com/Forums/en-US/isvvba/thread/a450830d-4fc3-4f4e-aee2-03f7994369d6
Dim pLookIn As String
Dim pSearchSubFolders As Boolean
Dim pFileName As String
Dim pFileType As String
Public pFoundFiles As New Collection
Private Sub Class_Initialize()
pLookIn = "."
pFileType = "*"
pFileName = "*"
pSearchSubFolders = False
End Sub
Public Function NewSearch()
Class_Initialize
Set pFoundFiles = New Collection
End Function
Public Property Get Count() As String
Count = pFoundFiles.Count
End Property
Public Property Get FoundFiles(xx) As String
FoundFiles = pFoundFiles(xx)
End Property
Public Property Get LookIn() As String
LookIn = pLookIn
End Property
Public Property Let LookIn(value As String)
pLookIn = value
End Property
Public Property Get SearchSubFolders() As Boolean
SearchSubFolders = pSearchSubFolders
End Property
Public Property Let SearchSubFolders(value As Boolean)
pSearchSubFolders = value
End Property
Public Property Get fileName() As String
fileName = pFileName
End Property
Public Property Let fileName(value As String)
pFileName = value
End Property
Public Property Get fileType() As String
fileType = pFileType
End Property
Public Property Let fileType(value As String)
pFileType = value
End Property
Public Function Execute() As Long
Dim i As Long
Dim sLookIn As String
Dim sDirName As String
Dim sCurDir As String
Dim sFileName As String
'Dim ff As FilesFound
i = 1
'Set ff = New FileSearchFound
sLookIn = pLookIn
RecurseFolder (sLookIn)
Execute = pFoundFiles.Count
End Function
Sub RecurseFolder(sFolderStart)
sFileName = Dir(sFolderStart & "\" & pFileName & "." & pFileType, vbNormal)
Do Until Len(sFileName) = 0
pFoundFiles.Add (sFolderStart & "\" & sFileName)
sFileName = Dir
Loop
If pSearchSubFolders Then
sDirName = Dir(sFolderStart & "\", vbDirectory)
Dim FoundDirectories As New Collection, xxDir As Variant
Do Until Len(sDirName) = 0
sCurDir = sFolderStart & "\" & sDirName
If GetAttr(sCurDir) = vbDirectory And sDirName <> "." And sDirName <> ".." Then
FoundDirectories.Add sCurDir
End If
sDirName = Dir
Loop
For Each xxDir In FoundDirectories
RecurseFolder (xxDir)
Next xxDir
End If
End Sub
Public Function Clear() As Long
NewSearch
End Function
|
