Sub SearchFilesForPath(ArrayOfSearchedFiles, FolderPath, FileExt)
    SearchMask = FolderPath & "\*." & FileExt
    FileName = Dir(SearchMask)
    While FileName <> ""
        If UCase(Right(FileName, Len(FileExt))) = UCase(FileExt) Then
            ArrayOfSearchedFiles.Add FolderPath & "\" & FileName
        End If
        FileName = Dir()
    Wend

End Sub

Sub SearchSiteFilesServ(fs, Collection, Path, FileType, Counter)

    Set Folder = fs.GetFolder(Path)
    
    Set FileCollection = New Collection
    
    FolderPath = Folder.Path
    
    If InStr( 1 , FileType, ";HTM;") <>  0  Then
        SearchFilesForPath FileCollection, FolderPath, "htm"
    End If
    If InStr( 1 , FileType, ";DOC;") <>  0  Then
        SearchFilesForPath FileCollection, FolderPath, "doc"
        SearchFilesForPath FileCollection, FolderPath, "docx"
    End If
    If InStr( 1 , FileType, ";XLS;") <>  0  Then
        SearchFilesForPath FileCollection, FolderPath, "xls"
        SearchFilesForPath FileCollection, FolderPath, "xlsx"
    End If
    
    
        
    For Each CurrentFileName In FileCollection
    'For Each file In Folder.Files
        Set file = fs.GetFile(CurrentFileName)
        OK = False
        ThisFileName = file.Path
        CheckHTML = (Right(file.Name,  3 ) = "htm" Or Right(file.Name,  4 ) = "html") And Left(file.Name,  2 ) <> "~$"
        CheckDOC = (Right(file.Name,  3 ) = "doc" Or Right(file.Name,  4 ) = "docx") And Left(file.Name,  2 ) <> "~$"
        CheckXLS = (Right(file.Name,  3 ) = "xls" Or Right(file.Name,  4 ) = "xlsx") And Left(file.Name,  2 ) <> "~$"
        CheckDOC2HTM = False
        If InStr( 1 , FileType, ";HTM;") <>  0  Then
            OK = OK Or CheckHTML
        End If
        If InStr( 1 , FileType, ";DOC;") <>  0  Then
            OK = OK Or CheckDOC
        End If
        If InStr( 1 , FileType, ";XLS;") <>  0  Then
            OK = OK Or CheckXLS
        End If
        If (CheckDOC And InStr( 1 , FileType, ";DOC2HTM;") <>  0 ) _
            Or (CheckXLS And InStr( 1 , FileType, ";XLS2HTM;") <>  0 ) Then
            SearchFileName = Replace(file.Path, ".doc", ".htm")
            SearchFileName = Replace(file.Path, ".doc", ".htm")
            SearchFileName = Replace(SearchFileName, ".xls", ".htm")
            SearchFileName = Replace(SearchFileName, ".xlsx", ".htm")
            
            If InStr( 1 , FileType, ";UPDATE;") <>  0  Then
                'Если файла нет, значит нужно обновлять...
                If fs.FileExists(SearchFileName) Then
                    Set SearchFile = fs.GetFile(SearchFileName)
                    CheckDOC2HTM = file.DateLastModified > SearchFile.DateLastModified
                Else
                    CheckDOC2HTM = True
                End If
            Else
                CheckDOC2HTM = fs.FileExists(SearchFileName)
            End If

            OK = OK And CheckDOC2HTM
        End If
       

        If OK Then
            Debug.Print file.Path
            Set ThisCollection = New Collection
            ThisCollection.Add file.Path, "FullName"
            ThisCollection.Add CheckHTML, "HTML"
            ThisCollection.Add CheckDOC, "DOC"
            ThisCollection.Add CheckDOC2HTM, "DOC2HTM"
            Collection.Add ThisCollection, file.Path
        End If
        Counter = Counter +  1 
        If Counter Mod  10  =  0  Then
            Application.StatusBar = Collection.Count() & " : " & file.Path
            DoEvents
        End If
        
    Next
    For Each SubFolder In Folder.SubFolders
        SearchSiteFilesServ fs, Collection, SubFolder.Path, FileType, Counter
    Next

End Sub