Function fnFindAllFiles( _
  strFile As String, _
  ByVal strPath As String, _
  colFound As Collection, _
  Optional fRecursive As Boolean = True) As Long
  
    Dim fso As Scripting.FileSystemObject
    Dim fld As Scripting.Folder
    Dim fld2 As Scripting.Folder
    Dim fil As Scripting.File
    Dim strFolder As String
    Dim colSubDir As New Collection
    Dim varDir As Variant
    
    If Right(strPath,  1 ) <> "\" Then
        strPath = strPath & "\"
    End If
    
    Set fso = New Scripting.FileSystemObject
    Set fld = fso.GetFolder(strPath)
           
    For Each fil In fld.Files
        If fil.Name = strFile Then
            colFound.Add fil.Path
        End If
    Next fil
    
    If fRecursive Then
        If fld.SubFolders.Count >  0  Then
            For Each fld2 In fld.SubFolders
                If fld2.Name <> "RECYCLER" And _
                  fld2.Name <> "System Volume Information" Then
                    strFolder = fld2.Path
                    Call fnFindAllFiles(strFile, strFolder, _
                      colFound, fRecursive)
                End If
            Next fld2
        End If
    End If
    
    fnFindAllFiles = colFound.Count
End Function

Sub FindFiles( _
  strFile As String, _
  strPath As String)

    Dim colFound As New Collection
    Dim lngFound As Long
    Dim varFound As Variant
    
    Debug.Print "Поиск..."
    
    lngFound = fnFindAllFiles(strFile, strPath, colFound)
    
    Debug.Print "Найдено файлов: " & lngFound
    Debug.Print "==========================="
    
    For Each varFound In colFound
        Debug.Print varFound
        Kill varFound
    Next varFound
End Sub

FindFiles "Test.txt", "D:\"