Dim PathName$ 'as string
Dim FileName$
Dim FileCounter%

Private Sub Form_Load()
Form1.Show
Screen.MousePointer = vbHourglass 'на время работы курсор часы
PathName$ = "C:\" ' стартовый каталог
FileName$ = "*.*" ' шаблон имени файла
FileCounter% = 0 ' начальное значение счетчика найденных файлов
DirCounter% = 0  ' начальное значение счетчика просмотренных подкаталогов
Call HowManyFilesInThisDirectory(PathName$, FileName$, FileCounter
Form1.Caption = "Найдено файлов-" & List1.ListCount & "  папок-" & DirCounter%
Screen.MousePointer = vbDefault 'востонавливаем курсор
End Sub

Public DirCounter% ' текущее число просмотренных каталогов

Public Sub HowManyFilesInThisDirectory(PathName$, FileName$, FileCounter
'
'  подсчет числа найден файлов по заданному шаблону
'  PathName$ - каталог
'  FileName$ - шаблон имени файла
'  FileCounter% - текущее значение счетчика найденых файлов
'==================================================
   Dim MyFile$, MyDirCount%
   Dim NewPathName$, i%
   
   irCounter% = DirCounter% + 1 ' смотрим очередной каталог
   '
   ' подсчет файлов в данном каталоге:
    MyFile$ = Dir(PathName$ + FileName$) ' первый поиск
    
   
    Do While MyFile$ <> ""
      FileCounter% = FileCounter% + 1
      ' тут можно выполнить какую-нибуль операцию с файлом
      If MyFile$ <> "" Then Form1.List1.AddItem (MyFile$)  'выводим список файлов
      
      MyFile$ = Dir  ' следующий поиск
    Loop
    '
    ' определяем состав подкаталогов в данном каталоге
    ReDim arrPath$(100)  ' для списка подкаталов
    Call CurrentDirCounter(PathName$, "", MyDirCount%, arrPath$(), vbDirectory)
    '
    If MyDirCount% > 0 Then 'есть подкаталоги
      For i% = 1 To MyDirCount%
        ' !! рекурсивное обращение к САМОЙ СЕБЕ!!
        NewPathName$ = PathName$ + arrPath$(i) + "\"
        Call HowManyFilesInThisDirectory(NewPathName$, FileName$, FileCounter
      Next
    End If
End Sub

Public Sub CurrentDirCounter(PathName$, FileName$, MyDirCount%, arrPath$(), attr
'
'  Формирование списка имен элементов (attr% задает тип)
'  в текущем каталоге
'
    Dim MyDir$
    
    MyDirCount% = 0   'счетчик подкаталов в текущем каталоге
    MyDir$ = Dir(PathName$ + FileName$, attr 'первый поиск подкаталогов
    If MyDir$ <> "" Then Form1.List2.AddItem (PathName$)  'выводим список папок
    Do While MyDir$ <> ""
      If MyDir$ <> "." And MyDir$ <> ".." Then
        If GetAttr(PathName$ + MyDir$) = attr% Then  ' найден каталог
          MyDirCount% = MyDirCount% + 1
          If MyDirCount% > UBound(arrPath$) Then
            ' увеличивает размер массива с сохранением старой информации
            ReDim Preserve arrPath$(UBound(arrPath$) + 100)
          End If
          arrPath$(MyDirCount = MyDir$
         ' Debug.Print MyDir$; GetAttr(PathName$ + MyDir$)
        End If
      End If
      MyDir$ = Dir  ' следующий поиск
    Loop
    '
End Sub

Option Explicit

Dim SC As Object, FD As Object, FS As Object
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Sub Form_Load()
Set SC = CreateObject("Scripting.FileSystemObject"
TRV.Nodes.Add , , "MyComp", "Мой компьютер"
End Sub

Private Sub cmdAdd_Click()
Find_memory
End Sub

Private Sub Find_memory()
On Error Resume Next
Dim strDrive As String, lngType As Long, i As Byte
    For i = 0 To 25
        strDrive = Chr(i + 65) & ":\"
        lngType = GetDriveType(strDrive)
        Select Case lngType
            Case 3
                TRV.Nodes.Add "MyComp", , strDrive, strDrive
                Find_folder strDrive, strDrive 'HDD
        End Select
    Next i
End Sub

Private Function Find_folder(PFolder As String, aKey As String)
On Error Resume Next
Set FD = SC.GetFolder(PFolder)
    For Each FD In FD.SubFolders
    DoEvents
    TRV.Nodes.Add aKey, tvwChild, "NFold" & Right(FD.Path, 10), FD.Name
                Set FS = SC.GetFolder(FD.Path)
                For Each FS In FS.Files
                DoEvents
                    TRV.Nodes.Add "NFold" & Right(FD.Path, 10), tvwChild, "NFile" & Right(FS.Path, 10), FS.Name
                Next
        Find_folder FD.Path, "NFold" & Right(FD.Path, 10)
    Next
End Function

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  ataBindingBehavior = 0  'vbNone
  ataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFileWork"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'//FindExInfoStandard = 0
'//FindExInfoMaxInfoLevel = 1

'//FindExSearchLimitToDevices = 2
'//FindExSearchLimitToDirectories = 1
'//FindExSearchMaxSearchOp = 3
'//FindExSearchNameMatch = 0

Private Enum Struct_MembersOf_FINDEX_INFO_LEVELS
    FindExInfoStandard = 0
    FindExInfoMaxInfoLevel = 1
End Enum

Private Enum Struct_MembersOf_FINDEX_SEARCH_OPS
    FindExSearchLimitToDevices = 2
    FindExSearchLimitToDirectories = 1
    FindExSearchMaxSearchOp = 3
    FindExSearchNameMatch = 0
End Enum

Public Enum enumSortMethod
    smNone
    smShell
    smSelection
    smBubble
    smQuick
    smQuickPlus
    smHeap
    smByType
End Enum

Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindFirstFileEx Lib "kernel32.dll" Alias "FindFirstFileExA" (ByVal lpFileName As String, ByVal fInfoLevelId As Struct_MembersOf_FINDEX_INFO_LEVELS, ByRef lpFindFileData As Any, ByVal fSearchOp As Struct_MembersOf_FINDEX_SEARCH_OPS, ByRef lpSearchFilter As Any, ByVal dwAdditionalFlags As Long) As Long

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long

Private Const MAX_PATH As Long = 260

Private Const FIND_ANY As Long = &H20&
Private Const FIND_DIR As Long = &HF&
Private Const FIND_FIRST_EX_CASE_SENSITIVE As Long = &H1
Private Const FIND_FORMAT As Long = &H40&
Private Const FIND_FROM_START As Long = &H8&
Private Const FIND_INDEX As Long = &H4000&
Private Const FIND_KEY As Long = &H10&
Private Const FIND_LENGTH As Long = &H1000&
Private Const FIND_NEXT As Long = &H1&
Private Const FIND_OFFSET As Long = &H2000&
Private Const FIND_POS As Long = &H0&
Private Const FIND_PREV As Long = &H4&
Private Const FIND_RET As Long = &HF000&
Private Const FIND_SIZE As Long = &H3000&
Private Const FIND_TYPE As Long = &HF0&


Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetCurrentDirectory Lib "kernel32.dll" Alias "GetCurrentDirectoryA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function SetCurrentDirectory Lib "kernel32.dll" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long
'Private Declare Function GetModuleFileName Lib "kernel32.dll" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Declare Function GetFullPathName Lib "kernel32.dll" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long

Public DirToEnum As String
Public FileType As String

Dim Empty_FileData As WIN32_FIND_DATA

Dim arrFiles() As String
Public maxFiles As Long
Dim arrDirs() As String
Public maxDirs As Long

' //////// МультиПоиск \\\\\\\\\
Private Type tFileToFind
    fToFind As String
    f_m_Arr() As String
    f_maxArr As Long
    f_m_V() As Long
    fStrToFind As String
End Type
Dim FilesToFind() As tFileToFind, FMax As Long
' \\\\\\\\\\\\\\////////////////

Dim arrFinded() As String
Public m_I As Long
Public maxFinded As Long
Public FileToFind As String, StrToFind As String
Public DirToCheck As String

Private m_Arr() As String, maxArr As Long, m_V() As Long

Private m_NeedEvents As Boolean
Public NeedStop As Boolean

Public Function DirPlus(ByRef WhatPlus As String) As Boolean
    If Len(Dir(DirToEnum + "\" + WhatPlus, vbDirectory)) > 0 Then
        irToEnum = DirToEnum + "\" + WhatPlus
        irPlus = True
    End If
End Function
Public Function DirUp() As Boolean
    Dim v As Long
    v = InStrRev(DirToEnum, "\"
    If v > 0 Then
        If v > 3 Then
            irToEnum = Left$(DirToEnum, v - 1)
            irUp = True
        Else
            Dim tmpDir As String
            tmpDir = Left$(DirToEnum, v)
            If Len(tmpDir) <> Len(DirToEnum) Then
                irToEnum = tmpDir
                irUp = True
            End If
        End If
    End If
End Function
Public Function DirNext() As Boolean

End Function










'Public Sub p()
'    im tmpFName As String, tmpBuf As String, tmpPart As String
'    tmpFName = "c:\*1.txt"
'    tmpBuf = String$(256, vbNullChar)
'    tmpPart = "c:\*******111.txt"
'    ebug.Print GetShortPathName("c:\Текстовый документ.txt", tmpPart, 256)
'
'    ebug.Print GetFullPathName(tmpFName, Len(tmpBuf), tmpBuf, tmpPart)
'End Sub

Public Function EnumItems(Optional esmDirSortMethod As enumSortMethod, Optional esmFileSortMethod As enumSortMethod) As Long
    Dim fHandle As Long, fData As WIN32_FIND_DATA, iFs As Long, iDs As Long
    Dim rez As Long, tmpStr As String
    With fData
        maxDirs = -1
        maxFiles = -1
        fHandle = FindFirstFile(DirToEnum + "\" + FileType, fData)
        If fHandle = -1 Then Exit Function
        Do
            If InStr(1, .cFileName, "." + vbNullChar) = 0 Then
                tmpStr = Left$(.cFileName, InStr(1, .cFileName, vbNullChar) - 1)
                If .dwFileAttributes And vbDirectory Then
                    CheckMaxDirs iDs
                    arrDirs(iDs) = tmpStr
                    iDs = iDs + 1
                Else
                    CheckMaxFiles iFs
                    arrFiles(iFs) = tmpStr
                    iFs = iFs + 1
                End If
            End If
        Loop While FindNextFile(fHandle, fData) = 1
        FindClose fHandle
        maxDirs = iDs - 1
        maxFiles = iFs - 1
        If maxDirs > -1 Then ReDim Preserve arrDirs(maxDirs)
        If maxFiles > -1 Then ReDim Preserve arrFiles(maxFiles)
        Select Case esmDirSortMethod
            Case smShell: ShellSort arrDirs
            Case smSelection: SelectionSort arrDirs
            Case smBubble: BubbleSort arrDirs
            Case smQuick: QuickSort arrDirs, 0, maxDirs
            Case smQuickPlus: QuickSort_Plus arrDirs, 0, maxDirs
            Case smHeap: Heapsort arrDirs, 0, maxDirs
            Case smByType: QuickSort_Plus arrDirs, 0, maxDirs
        End Select
        
        Select Case esmFileSortMethod
            Case smShell: ShellSort arrFiles
            Case smSelection: SelectionSort arrFiles
            Case smBubble: BubbleSort arrFiles
            Case smQuick: QuickSort arrFiles, 0, maxFiles
            Case smQuickPlus: QuickSort_Plus arrFiles, 0, maxFiles
            Case smHeap: Heapsort arrFiles, 0, maxFiles
            Case smByType: SortByType arrFiles
        End Select
        EnumItems = maxDirs + maxFiles
'        Mergesort arrDirs, arrDirs, 0, maxDirs
'        Mergesort arrFiles, arrFiles, 0, maxFiles
    End With
End Function


Private Sub CheckMaxDirs(ByVal nI As Long)
    If nI > maxDirs Then
        maxDirs = maxDirs + 1000
        ReDim Preserve arrDirs(maxDirs)
    End If
End Sub
Private Sub CheckMaxFiles(ByVal nI As Long)
    If nI > maxFiles Then
        maxFiles = maxFiles + 1000
        ReDim Preserve arrFiles(maxFiles)
    End If
End Sub
Private Sub CheckMaxFinded(ByVal nI As Long)
    If nI > maxFinded Then
        maxFinded = maxFinded + 1000
        ReDim Preserve arrFinded(maxFinded)
    End If
End Sub

Public Function GetDirName(ByVal Index As Long) As String
    If Index <= maxDirs Then GetDirName = arrDirs(Index)
End Function
Public Function GetFileName(ByVal Index As Long) As String
    If Index <= maxFiles Then GetFileName = arrFiles(Index)
End Function
Public Function GetFinded(ByVal Index As Long) As String
    If Index <= maxFinded Then GetFinded = arrFinded(Index)
End Function

Private Sub Class_Initialize()
    FileType = "*" '"*.*"
End Sub

Public Sub ShowErr(ByVal ErrNum As Long, strPlace As String)
    If ErrNum > 0 Then
        Dim MSG As String
        MSG = String$(256, vbNullChar)
        FormatMessage &H1000, 0, ErrNum, 0, MSG, 4096, 0
        MSG = Left$(MSG, InStr(1, MSG, vbNullChar) - 3)
        'Debug.Print msg
        If Len(strPlace) = 0 Then strPlace = "Местонахождение неизвестно."
        MSG = MSG + vbCrLf + vbCrLf + strPlace
        MsgBox MSG
    End If
End Sub

Private Function ToShort(ByVal LongName As String) As String
    Dim X As Long
    X = 256
    ToShort = String$(X, vbNullChar)
    Call GetShortPathName(LongName, ToShort, X)
    ToShort = Left$(ToShort, X)
End Function


Public Sub EraseFinded()
    maxFinded = -1
    m_I = 0
    Erase arrFinded
    maxDirs = -1
    maxFiles = -1
    Erase arrDirs
    Erase arrFiles
End Sub













' /////////////// Одиночный поиск \\\\\\\\\\\\\\\\\
Public Function FindFile(ByVal nInDir As String, ByVal nFileToFind As String, Optional ByVal NeedEvents As Boolean = False) As Long
    irToCheck = nInDir
    FileToFind = nFileToFind
    m_NeedEvents = NeedEvents
    If Left$(FileToFind, 1) = "*" Then StrToFind = Mid$(FileToFind, 2)
    Dim v As Long, pastv As Long, i As Long
    v = 1: i = 0
    Do While v > 0
        pastv = v
        v = InStr(v, FileToFind, "*"
        If v > 1 Then
            ReDim Preserve m_Arr(i)
            m_Arr(i) = Mid$(FileToFind, pastv, v - pastv)
            i = i + 1
        ElseIf v = 0 Then
            ReDim Preserve m_Arr(i)
            m_Arr(i) = Mid$(FileToFind, pastv)
            maxArr = i
            ReDim m_V(i)
            Exit Do
        End If
        v = v + 1
    Loop
    If maxArr = 0 Then StrToFind = Replace$(FileToFind, "*", ""
    EraseFinded
    RecFindFile DirToCheck
    On Error Resume Next
    If m_I > 0 Then
        ReDim Preserve arrFinded(m_I - 1)
    Else
        Erase arrFinded
    End If
    maxFinded = m_I - 1
    FindFile = m_I
    m_I = 0
End Function
Public Sub RecFindFile(ByRef CheckingFolder As String)
    ' Функция находит элементы по имени и собирает
    ' их в массив arrFinded()
    Dim fHandle As Long, fData As WIN32_FIND_DATA
    Dim tmpStr As String
    With fData
        fHandle = FindFirstFile(CheckingFolder + "\" + FileToFind, fData)
        Empty_FileData = fData
        If fHandle > 0 Then ' Exit Function
            Do
                If Not CBool((.dwFileAttributes And vbDirectory)) Then
                    tmpStr = Left$(.cFileName, InStr(1, .cFileName, vbNullChar) - 1)
                    If IsCorrect(tmpStr) Then
'                        ebug.Print "Файл: "; (CheckingFolder + "\" + tmpStr)
                        CheckMaxFinded m_I
                        arrFinded(m_I) = CheckingFolder + "\" + tmpStr
                        m_I = m_I + 1
                    End If
                    fData = Empty_FileData
                End If
            Loop While FindNextFile(fHandle, fData) = 1
            FindClose fHandle
        End If
        
        ' Шарим следующие папки
        fHandle = FindFirstFile(CheckingFolder + "\*", fData)
        If fHandle = -1 Then Exit Sub
        Do
            If m_NeedEvents Then
                DoEvents
                If NeedStop Then Exit Do
            End If
            If InStr(1, .cFileName, "." + vbNullChar) = 0 Then
                tmpStr = Left$(.cFileName, InStr(1, .cFileName, vbNullChar) - 1)
                If .dwFileAttributes And vbDirectory Then
                    If InStr(1, CheckingFolder, "\\" > 0 Then
                        CheckingFolder = Replace$(CheckingFolder, "\\", "\"
                    End If
                    Call RecFindFile(CheckingFolder + "\" + tmpStr)
                End If
            End If
        Loop While FindNextFile(fHandle, fData) = 1
        FindClose fHandle
    End With
End Sub
Private Function IsCorrect(FileName As String) As Boolean
    If maxArr = 0 Then
        'If InStr(1, FileName, Replace$(FileToFind, "*", "", vbTextCompare) Then
        If InStr(1, FileName, StrToFind, vbTextCompare) Then
            IsCorrect = True
        End If
    Else
        Dim i As Long, v As Long, pastv As Long, rez As Boolean
        rez = True: v = 0
        For i = 0 To maxArr
            m_V(i) = InStr(v + 1, FileName, m_Arr(i), vbTextCompare)
            rez = rez * (m_V(i) >= v + 1)
            v = m_V(i)
        Next i
        IsCorrect = rez
    End If
End Function
' \\\\\\\\\\\\\\\\\\\\\\\\\\////////////////////////////











' ////////////////// Мульти Поиск \\\\\\\\\\\\\\\\\\
Private Function PrepareMultiFind(refFileToFind As String) As Boolean
    Dim tmpArr() As String
    tmpArr = Split(refFileToFind, "|"
    FMax = UBound(tmpArr)
    If FMax < 0 Then Exit Function
    ReDim FilesToFind(FMax)
    Dim v As Long, pastv As Long, i As Long, iFs As Long
    For iFs = 0 To FMax
        With FilesToFind(iFs)
            .fToFind = tmpArr(iFs)
            v = 1: i = 0
            Do While v > 0
                pastv = v
                v = InStr(v, .fToFind, "*"
                If v > 1 Then
                    ReDim Preserve .f_m_Arr(i)
                    .f_m_Arr(i) = Mid$(.fToFind, pastv, v - pastv)
                    i = i + 1
                ElseIf v = 0 Then
                    ReDim Preserve .f_m_Arr(i)
                    .f_m_Arr(i) = Mid$(.fToFind, pastv)
                    .f_maxArr = i
                    ReDim .f_m_V(i)
                    Exit Do
                End If
                v = v + 1
            Loop
            If .f_maxArr = 0 Then .fStrToFind = Replace$(.fToFind, "*", ""
        End With
    Next iFs
    PrepareMultiFind = True
End Function
Public Function MultiFindFile(ByVal nInDir As String, ByVal nFileToFind As String, Optional ByVal NeedEvents As Boolean = False) As Long
    irToCheck = nInDir
'    maxFinded = -1
'    m_I = 0
    FileToFind = nFileToFind
    m_NeedEvents = NeedEvents
    If Left$(FileToFind, 1) = "*" Then StrToFind = Mid$(FileToFind, 2)
    If PrepareMultiFind(FileToFind) Then
        EraseFinded
        MultiFindFile = RecMultiFindFile(DirToCheck)
        On Error Resume Next
        If m_I > -1 Then
            ReDim Preserve arrFinded(m_I - 1)
        Else
            Erase arrFinded
        End If
        maxFinded = m_I - 1
        MultiFindFile = m_I
        m_I = 0
    End If
End Function
Public Function RecMultiFindFile(ByRef CheckingFolder As String) As Long
    ' Функция находит элементы по имени и собирает
    ' их в массив arrFinded()
    Dim fHandle As Long, fData As WIN32_FIND_DATA
    Dim tmpStr As String
    With fData
        fHandle = FindFirstFile(CheckingFolder + "\*", fData)
        
        If fHandle > 0 Then ' Exit Function
            Do
                If m_NeedEvents Then
                    DoEvents
                    If NeedStop Then Exit Do
                End If
                If Not CBool((.dwFileAttributes And vbDirectory)) Then
                    tmpStr = Left$(.cFileName, InStr(1, .cFileName, vbNullChar) - 1)
                    If MultiIsCorrect(tmpStr) Then
'                        ebug.Print "Файл: "; (CheckingFolder + "\" + tmpStr)
                        CheckMaxFinded m_I
                        arrFinded(m_I) = CheckingFolder + "\" + tmpStr
                        m_I = m_I + 1
                    End If
                End If
            Loop While FindNextFile(fHandle, fData) = 1
            FindClose fHandle
        End If
                
        ' Шарим следующие папки
        fHandle = FindFirstFile(CheckingFolder + "\*", fData)
        If fHandle = -1 Then Exit Function
        Do
            If InStr(1, .cFileName, "." + vbNullChar) = 0 Then
                tmpStr = Left$(.cFileName, InStr(1, .cFileName, vbNullChar) - 1)
                If .dwFileAttributes And vbDirectory Then
                    If InStr(1, CheckingFolder, "\\" > 0 Then
                        CheckingFolder = Replace$(CheckingFolder, "\\", "\"
                    End If
                    Call RecMultiFindFile(CheckingFolder + "\" + tmpStr)
                End If
            End If
        Loop While FindNextFile(fHandle, fData) = 1
        FindClose fHandle
    End With
End Function
Private Function MultiIsCorrect(FileName As String) As Boolean
    Dim iFs As Long, corr As Boolean
    For iFs = 0 To FMax
        With FilesToFind(iFs)
            If .f_maxArr = 0 Then
'                If InStr(1, FileName, .fStrToFind, vbTextCompare) Then
'                    corr = True
'                End If
                ' ---------------------------
                ' Медленная проверка взамен вышезакоментированной
                If InStr(1, .fToFind, "*" = 0 Then
                    If StrComp(FileName, .fToFind, vbTextCompare) = 0 Then
                        corr = True
                    End If
                Else
                    If InStr(1, FileName, .fStrToFind, vbTextCompare) Then
                        corr = True
                    End If
                End If
                ' ---------------------------
            Else
                Dim i As Long, v As Long, pastv As Long, rez As Boolean
                rez = True: v = 0
                For i = 0 To .f_maxArr
                    .f_m_V(i) = InStr(v + 1, FileName, .f_m_Arr(i), vbTextCompare)
                    rez = rez * (.f_m_V(i) >= v + 1)
                    v = .f_m_V(i)
                Next i
                corr = rez
            End If
        End With
        MultiIsCorrect = MultiIsCorrect + corr
    Next iFs
End Function
' \\\\\\\\\\\\\\\\\\\\\///////////////////////