'This source code is provided "as is" and without warranties as to performance or merchantability.
'The author and/or distributors of this source code may have made statements about this source code.
'Any such statements do not constitute warranties and shall not be relied on by the user in deciding
'whether to use this source code.
'
'This source code is provided without any express or implied warranties whatsoever. Because of the
'diversity of conditions and hardware under which this source code may be used, no warranty of fitness
'for a particular purpose is offered. The user is advised to test the source code thoroughly before
'relying on it. The user must assume the entire risk of using the source code.
'Class developed by Henrique Heidemann Cardoso
'If you have any commentaries please address it to hheidemann@gmail.com
'+551297067969
'You can distribute this code freely provided you do not remove the notes above
Private fileNameMask As String
Private fileNameMaskText As String
Private fileNameMaskExtText As String
Private fileNameMaskVector() As String
Private fileNameMaskExtVector() As String
Private fs As Scripting.FileSystemObject
Private searchMethod As String
Private Sub setMask(ByVal fileNameMaskToMatch As String)
fileNameMask = fileNameMaskToMatch
Dim dotPosition As Long
dotPosition = InStrRev(fileNameMask, ".", -1, vbTextCompare)
If dotPosition > 0 Then
searchMethod = "NameAndExtension"
fileNameMaskText = Left(fileNameMask, dotPosition - 1)
fileNameMaskExtText = Right(fileNameMask, Len(fileNameMask) - dotPosition)
If InStr(1, fileNameMaskText, "*", vbTextCompare) > 0 Then
searchMethod = searchMethod & "WithWildChars"
fileNameMaskVector = Split(fileNameMaskText, "*", -1, vbTextCompare)
End If
If InStr(1, fileNameMaskExtText, "*", vbTextCompare) > 0 Then
searchMethod = searchMethod & "WithWildCharsInExtension"
fileNameMaskExtVector = Split(fileNameMaskExtText, "*", -1, vbTextCompare)
End If
Else
searchMethod = "NameOnly"
If InStr(1, "*", fileNameMask, vbTextCompare) > 0 Then _
searchMethod = searchMethod & "WithWildChars"
End If
End Sub
Private Function doesNameMatch(ByVal FileName As String) As Boolean
Dim dotPosition As Long
dotPosition = InStrRev(FileName, ".", -1, vbTextCompare)
Dim fileNameText As String
Dim fileNameExtText As String
fileNameText = Left(FileName, dotPosition - 1)
fileNameExtText = Right(FileName, Len(FileName) - dotPosition)
If searchMethod = "NameAndExtension" Then
If StrComp(fileNameMask, FileName, vbTextCompare) = 0 Then
doesNameMatch = True
Else
doesNameMatch = False
End If
ElseIf searchMethod = "NameAndExtensionWithWildChars" Then
If StrComp(fileNameMaskExtText, fileNameExtText, vbTextCompare) = 0 Then
If specialStrComp(fileNameMaskVector, fileNameText) = 0 Then
doesNameMatch = True
Else
doesNameMatch = False
End If
Else
doesNameMatch = False
End If
ElseIf searchMethod = "NameAndExtensionWithWildCharsWithWildCharsInExtension" Then
If specialStrComp(fileNameMaskExtVector, fileNameExtText) = 0 Then
If specialStrComp(fileNameMaskVector, fileNameText) = 0 Then
doesNameMatch = True
Else
doesNameMatch = False
End If
Else
doesNameMatch = False
End If
ElseIf searchMethod = "NameOnly" Then
If StrComp(fileNameMask, FileName, vbTextCompare) = 0 Then
doesNameMatch = True
Else
doesNameMatch = False
End If
ElseIf searchMethod = "NameOnlyWithWildChars" Then
If specialStrComp(fileNameMaskVector, FileName) = 0 Then
doesNameMatch = True
Else
doesNameMatch = False
End If
End If
End Function
Private Function specialStrComp(ByRef aStringVector() As String, _
ByVal aString As String) As Integer
Dim i As Long
Dim cursor As Long
Dim ittString As String
cursor = 1
specialStrComp = 0
For i = 0 To UBound(aStringVector)
If cursor > Len(aString) Then
specialStrComp = -1
Exit For
End If
ittString = aStringVector(i)
If Len(Trim$(ittString)) <= 0 Then
cursor = cursor + 1
Else
If i > 0 Then
If Len(Trim$(aStringVector(i - 1))) > 0 Then _
cursor = cursor + 1
End If
If i = 0 Then
If StrComp(ittString, Left(aString, Len(ittString)), vbTextCompare) <> 0 Then
specialStrComp = -1
Exit For
Else
cursor = cursor + Len(ittString)
End If
ElseIf i = UBound(aStringVector) Then
If StrComp(ittString, Right(aString, Len(ittString)), vbTextCompare) <> 0 Then
specialStrComp = -1
Else
specialStrComp = 0
End If
Exit For
Else
Dim ittFoundPos As Integer
ittFoundPos = InStr(cursor, aString, ittString, vbTextCompare)
If Not (ittFoundPos > 0) Then
specialStrComp = -1
Exit For
Else
cursor = ittFoundPos + Len(ittString)
End If
End If
End If
Next i
End Function
Sub alternateFileSearch(ByVal initialPath As String, _
ByVal fileNameMaskToSearch As String, _
ByRef foundFiles As Collection)
setMask fileNameMaskToSearch
Dim oFolder As Scripting.Folder
If fs.FolderExists(initialPath) Then
If foundFiles Is Nothing Then _
Set foundFiles = New Collection
Set oFolder = fs.getFolder(initialPath)
recursiveSearchForFiles oFolder, foundFiles
End If
End Sub
Private Sub recursiveSearchForFiles(ByRef oFolder As Scripting.Folder, _
ByRef foundFiles As Collection)
addFilesToColection oFolder, foundFiles
Dim ittFolder As Scripting.Folder
For Each ittFolder In oFolder.SubFolders
recursiveSearchForFiles ittFolder, foundFiles
Next ittFolder
End Sub
Private Sub addFilesToColection(ByRef oFolder As Scripting.Folder, _
ByRef foundFiles As Collection)
Dim ittFile As Scripting.File
For Each ittFile In oFolder.Files
If doesNameMatch(ittFile.Name) Then _
foundFiles.Add ittFile.Path
Next ittFile
End Sub
Private Sub Class_Initialize()
Set fs = New Scripting.FileSystemObject
End Sub
Private Sub Class_Terminate()
Set fs = Nothing
End Sub
