[RESOLVED] Directory Searching

[Torc]

Thanks Westconn,

I had to make a few adjustments, but the code below works

However when I ran it against my current live directories, Circa 15,000+, it
took approx 10 Minutes to run.

Any ideas as to how it could be speeded up?

Global arrfound()
Sub findsubfolders(spath, spattern As String)
Dim myfile As String, dirarr() As String, cnt As Long, i As Long
 
ReDim dirarr(100)
cnt = 0
    myfile = Dir(spath & "\*.*", vbDirectory)
        Do While Not myfile = ""
            If Not myfile = "." And Not myfile = ".." Then
                If (GetAttr(spath & "\" & myfile) And vbDirectory) <> 0 Then
                    If LCase(myfile) Like LCase(spattern) Then
                        If Not IsEmpty(arrfound(UBound(arrfound))) Then
                            ReDim Preserve arrfound(UBound(arrfound) + 1)
                        End If
                        arrfound(UBound(arrfound)) = spath & "\" & myfile
                    End If
                    If cnt = UBound(dirarr) Then ReDim Preserve dirarr(UBound(dirarr) + 100)
                    dirarr(cnt) = spath & "\" & myfile
                    cnt = cnt + 1
'               **** file search
'               ElseIf LCase(myfile) Like LCase(spattern) Then dostuff spath & "\" & myfile
                End If
            End If
            myfile = Dir
        Loop
            If Not cnt = 0 Then
                cnt = cnt - 1
                ReDim Preserve dirarr(cnt)
                    For i = 0 To UBound(dirarr)
                        findsubfolders dirarr(i), spattern
                    Next
            End If
End Sub
 
Sub findfile()
'set starting folder and files to match
'reset array
Dim counter As Long
Dim StartTime As Date
    StartTime = Now
    OutputRow = 1
    CountRow = 1
ReDim arrfound(0)
    ThisWorkbook.Worksheets("Sheet1").Cells.Delete
    ThisWorkbook.Worksheets("Sheet2").Cells.Delete
Call findsubfolders("V:\Notes", "*10408*")
 
'arrfound will now contain all the folders (complete path) in the tree below the starting folder, that match the pattern
    If Not IsEmpty(arrfound) then
        For counter = LBound(arrfound) To UBound(arrfound)
            Debug.Print counter & " :: " & arrfound(counter)
        Next counter
    End if
    Debug.Print StartTime & " :: " & Now
End Sub