Метод поиска файлов и папок в Visual Basic

Option Explicit
 
Public FullFileName() As String 'Массив полных путей найденных файлов
Public fCount As Long           'Количество найденных по маске файлов
 
Sub Find_Test()
    Dim Drv As String
    Dim Pth As String
    Dim fFile As String
    
    Dim I As Long
    
    ReDim FullFileName(1 To 100) ' Для увеличения быстродействия увеличиваем массив с шагом в 100
    
    fCount = 0      ' Инициализация счетчика
    Drv = 'C'       ' Поиск на диске C:
    Pth = ' '       ' Путь, с которого начинается поиск
    fFile = '*.ba?' ' Маска для поиска
 
    ChDrive Drv     ' Установка текущего диска...
    Call FindFile(fFile, Pth)   ' и старт рекурсивного поиска
 
    MsgBox 'Поиск по маске ''' & fFile & ''' завершен !' & vbCr & _
        'найдено ' & fCount & ' файлов.', vbOKOnly Or vbInformation, 'Диск ' & Left(CurDir, 2)
    
    
    For I = 1 To fCount
        Debug.Print FullFileName(I) ' выводим массив
    Next I
End Sub
 
Sub FindFile(fFile As String, Pth As String)
    Dim AllDirs() As String
    ReDim AllDirs(1 To 100)
    Dim I As Integer
    Dim M As Integer
    Dim strFile As String
    Dim Cur As String
    
    ChDir Pth
    Cur = CurDir
    If Not Right(Cur, 1) = ' ' Then Cur = Cur & ' '
    strFile = Dir(fFile, vbHidden Or vbSystem Or vbReadOnly)
    Do Until Len(strFile) = 0
        fCount = fCount + 1
        M = UBound(FullFileName())
        If fCount > M Then ReDim Preserve FullFileName(1 To M + 100)
        FullFileName(fCount) = Cur & strFile
        strFile = Dir()
    Loop
    
    strFile = Dir('*.*', vbHidden Or vbSystem Or vbReadOnly Or vbDirectory)
    Do Until Len(strFile) = 0
        If GetAttr(strFile) = vbDirectory Then
            If strFile <> '.' And strFile <> '..' Then
                I = I + 1
                M = UBound(AllDirs())
                If I > M Then ReDim Preserve AllDirs(1 To M + 100)
                AllDirs(I) = strFile
            End If
        End If
        strFile = Dir()
    Loop
    M = I
    For I = 1 To M
        Call FindFile(fFile, AllDirs(I))
    Next I
 
    ChDir Cur & '..'
End Sub