Option Explicit
Private myRootPath As String
Private myWorkCol As Collection
Public Function SearchSubPaths(strFolder As String, strSearchFolder As String, Optional ByVal caseSensitiveSearch As Boolean = False) As Collection
Set myWorkCol = New Collection
strFolder = strFolder & IIf(Right(strFolder, 1) = "\", "", "\")
myWorkCol.Add strFolder
Set SearchSubPaths = SearchSubFolders(strSearchFolder, caseSensitiveSearch)
End Function
Private Function SearchSubFolders(strSearchFolder As String, caseSensitiveSearch As Boolean) As Collection
Dim colOut As New Collection
Dim strTemp As String
Do Until myWorkCol.Count = 0
strTemp = Dir(myWorkCol.Item(1), vbDirectory)
Do Until strTemp = vbNullString
If Not (strTemp = "." Or strTemp = "..") Then
If GetAttr(myWorkCol.Item(1) & strTemp) = vbDirectory Then
myWorkCol.Add myWorkCol.Item(1) & strTemp & "\"
End If
End If
strTemp = Dir()
Loop
If (InStr(myWorkCol.Item(1), strSearchFolder) > 0 And caseSensitiveSearch) Or (InStr(LCase(myWorkCol.Item(1)), LCase(strSearchFolder)) > 0 And Not caseSensitiveSearch) Then
colOut.Add myWorkCol.Item(1)
End If
myWorkCol.Remove 1
Loop
If colOut.Count > 0 Then
sortCollection colOut, True
End If
Set SearchSubFolders = colOut
End Function
Private Sub sortCollection(ByRef col As Collection, Optional ByVal bUp As Boolean = True)
Dim vItem As Variant
Dim iPos As Integer
iPos = 1
Do While col.Count > iPos
If (col.Item(iPos) > col.Item(iPos + 1) And bUp) Or (col.Item(iPos) < col.Item(iPos + 1) And Not bUp) Then
vItem = col.Item(iPos)
col.Remove iPos
col.Add Item:=vItem, After:=iPos
iPos = iPos - IIf(iPos > 1, 1, 0)
Else
iPos = iPos + 1
End If
Loop
End Sub