Just paste this source code into a class module called cFindFiles and include it in your project.
'----------------------------------------------------------------------
'
' Class Name: cFindFiles
' Written By: C&D Programming Corp.
' Create Date: 2/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
Private colFiles As New Collection ' to hold matching files
Private colDirs As New Collection ' to hold matching directories
Private mtxtStatus As Object ' place to show what directory we are up to.
' should normally be a text box or a label
Public Property Set StatusBox(txtStatus As Object)
Set mtxtStatus = txtStatus
End Property
Public Property Get StatusBox() As Object
Set StatusBox = mtxtStatus
End Property
Public Sub GatherDirectories(sPath As String)
Dim sFilename As String ' Walking sFilename variable.
Dim sDirName As Variant ' SubDirectory Name.
Dim bFoundDir As Boolean ' Found a directory on this pass
Dim colTempDirs As New Collection ' temporary collection for gathering directories
On Error GoTo ErrHandler
' Make sure there is a backslash on the path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
bFoundDir = False
sDirName = Dir(sPath, vbDirectory Or vbHidden) ' Even if hidden.
Do While Len(sDirName) > 0
' Ignore the current and parent directories.
If (sDirName <> ".") And (sDirName <> "..") Then
' Check for directory with bitwise comparison.
If GetAttr(sPath & sDirName) And vbDirectory Then
If Not StatusBox Is Nothing Then
StatusBox = sPath & sDirName
StatusBox.Refresh
End If
' remember this directory for later search of the file name
colDirs.Add sPath & sDirName
' remember the current directory for later so we can search it
' for more subdirectories
colTempDirs.Add sDirName
bFoundDir = True
End If
End If
sDirName = Dir() ' Get next subdirectory.
Loop
' If there were sub-directories found above...
If bFoundDir Then
' Recursively walk into them
For Each sDirName In colTempDirs
GatherDirectories sPath & sDirName & "\"
Next
End If
Exit Sub
ErrHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Sub
Public Function FindFiles(sPath As String, sSearchMask As String) As Collection
Dim sFilename As String ' Walking sFilename variable.
Dim sDirName As Variant ' SubDirectory Name.
Dim lDirs As Long
On Error GoTo ErrHandler
ClearDirCollection ' make sure the directory collection is erased
GatherDirectories sPath ' get list of valid directories below sPath
For lDirs = colDirs.Count To 1 Step -1
sDirName = colDirs.Item(lDirs)
' Search through directories and sum file sizes.
sFilename = Dir(sDirName & "\" & sSearchMask, _
vbNormal Or vbHidden Or vbSystem Or vbReadOnly)
If sFilename = "" Then
colDirs.Remove lDirs ' remove this directory since it does not contain
' any matching files
Else
Debug.Print sDirName
'
' loop through matching files in this directory.
'
While Len(sFilename) <> 0
'
' Add any file checking here to filter files further, such as date/time
' checking or size checking.
' In future issues we will show a way to add callback features to this
' routine so that you will not ever need to modify this code.
'
' Add to file collection here
colFiles.Add sDirName & "\" & sFilename
sFilename = Dir() ' Get next file.
Wend
End If
Next
' return collection of files
Set FindFiles = colFiles
Exit Function
ErrHandler:
Err.Raise Err.Number, Err.Source, Err.Description
Resume
End Function
Private Sub ClearDirCollection()
Dim lIndex As Long ' remove loop index
' make directory collection empty
If colDirs.Count > 0 Then
For lIndex = colDirs.Count - 1 To 0 Step -1
colDirs.Remove lIndex
Next
End If
Set colDirs = Nothing
End Sub
Private Sub Class_Initialize()
Set mtxtStatus = Nothing
End Sub