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

    Set Folder = fs.GetFolder(Path)
    For Each File In Folder.Files
        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 ) <> "~$"
        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 CheckDOC And InStr( 1 , FileType, ";DOC2HTM;") <>  0  Then
            SearchFileName = Replace(File.Path, ".doc", ".htm")
            SearchFileName = Replace(SearchFileName, ".docx", ".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

Public Sub ConvertDoc2HTMFiles()
    Set Files = SearchSiteFiles("DOC;DOC2HTM;UPDATE")
    KillAllWordProcesses
    Set Word = CreateObject("Word.Application")
    For Each File In Files
        FileName = File.Item("FullName")
        Application.StatusBar = File.Item("FullName")
        DoEvents
        ConvertDoc2HTMFile FileName, Word
    Next
    KillAllWordProcesses
    MsgBox "Convert Complete: " & Files.Count()

   
End Sub