ExclusionList(2)= .BuildPath(fromDir, "Избранное")

Set Desc = CreateObject("Shell.Application").Namespace(0)

                Desc.ParseName(targetFile).InvokeVerb("delete")

Set RecycleBin = CreateObject("Shell.Application").Namespace(&Ha)

                targetFile.Delete(True)

                RecycleBin.MoveHere(targetFile)

'Синхронизация содержимого двух каталогов

'**********************************************
'Исходный каталог
fromDir = "C:\4444444"

'Приемный каталог
'toDir = "\\TargetServer\d$\UserData"
toDir = "C:\5555"

'Сравнивать время изменения файлов с точностью до
' 2 секунд - при переносе файлов с NTFS на FAT
' 0 секунд - в остальных случаях
TimeDifference = 0

Set fso = CreateObject("Scripting.FileSystemObject")

'Подкаталоги ИСХОДНОГО каталога исключаемые из обработки
Dim ExclusionList(2)
With fso
    ExclusionList(0)= .BuildPath(fromDir, "_gsdata_")
    ExclusionList(1)= .BuildPath(fromDir, "index")
    ExclusionList(2)= .BuildPath(fromDir, "Temp\temporaryFolder")
End With
'**********************************************

replaceSize = 0
copySize = 0
deleteSize = 0
noChangeSize = 0

replaceCount = 0
deleteCount = 0
noChangeCount = 0
copyCount = 0

ExclusionListCount = 0

Call CheckFolder(fromDir)

Start = Timer

Call FoldersSynch(fromDir, toDir)

Finish = Timer

delim = vbTab & "...   :   "

Dim message(11)
message(0) = " Файлов без изменений" & delim & noChangeCount & vbTab & "[" & Conversion(noChangeSize) & "]"
message(1) = String(33, "-")
message(2) = " Удалено лишних" & vbTab & delim & deleteCount & vbTab & "[" & Conversion(deleteSize) & "]"
message(3) = " Заменено существующих" & delim & replaceCount & vbTab & "[" & Conversion(replaceSize) & "]"
message(4) = " Добавлено новых" & vbTab & delim & copyCount & vbTab & "[" & Conversion(copySize) & "]"
message(5) = String(33, "-")
message(6) = " Исключено каталогов" & delim & ExclusionListCount
message(7) = ""
message(8) = String(33, "-")
message(9) = " РАЗМЕР ОБНОВЛЕНИЙ" & delim & Conversion(replaceSize + copySize)
message(10) = ""
message(11) = " Время выполнения" & delim & (Finish - Start) & "   сек."

MsgBox Join(message, vbCrLf), vbInformation, "Сообщение синхронизатора"

Sub CheckFolder(FolderName)
If Not fso.FolderExists(FolderName) Then
    MsgBox "Нет доступа к ресурсу ''" & FolderName & "''", vbCritical, "Сообщение синхронизатора"
    WScript.Quit()
End If
End Sub

Sub FoldersSynch(source, target)
Dim sourceDir, sourceFile, targetDir, targetFile, sourceSubDir, targetSubDir
    Set sourceDir = fso.GetFolder(source)
    If Not FolderExcluded(source, ExclusionList) Then
        SmartCreateFolder target
        Set targetDir = fso.GetFolder(target)
        If targetDir.Attributes <> sourceDir.Attributes Then
            targetDir.Attributes = sourceDir.Attributes
        End If
        For Each targetFile in targetDir.Files
            If Not fso.FileExists(fso.BuildPath(source, targetFile.Name)) Then
                deleteSize = deleteSize + targetFile.Size
                targetFile.Delete(True)
                deleteCount = deleteCount + 1
            End If
        For Each sourceFile in sourceDir.Files
            If Not fso.FileExists(fso.BuildPath(target, sourceFile.Name)) Then
                sourceFile.Copy fso.BuildPath(target, sourceFile.Name)
                copySize = copySize + sourceFile.Size
                copyCount = copyCount + 1
            Else
                Set targetFile = fso.GetFile(fso.BuildPath(target, sourceFile.Name))
                If Abs(DateDiff("s", sourceFile.DateLastModified, targetFile.DateLastModified)) > TimeDifference Then
                    If targetFile.Attributes And 1 Then
                        targetFile.Attributes = targetFile.Attributes - 1
                    End If
                    sourceFile.Copy targetFile, True
                    replaceSize = replaceSize + sourceFile.Size
                    replaceCount = replaceCount + 1
                Else
                    If targetFile.Attributes <> sourceFile.Attributes Then
                        targetFile.Attributes = sourceFile.Attributes
                    End If
                    noChangeSize = noChangeSize + sourceFile.Size
                    noChangeCount = noChangeCount + 1
                End If
            End If
        Next 'sourceFile
        For Each sourceSubDir in sourceDir.SubFolders
            FoldersSynch sourceSubDir.Path, fso.BuildPath(target, sourceSubDir.Name)
        For Each targetSubDir in targetDir.SubFolders
            If Not fso.FolderExists(fso.BuildPath(source, targetSubDir.Name)) Then
                ExtraCount targetSubDir.Path, deleteCount
                deleteSize = deleteSize + targetSubDir.Size
                targetSubDir.Delete(True)
            End If
        Next 'targetSubDir
    Else
        ExclusionListCount = ExclusionListCount + 1
    End If
End Sub

Sub SmartCreateFolder(strFolder)
    If fso.FolderExists(strFolder) Then
        Exit Sub
    Else
        SmartCreateFolder(fso.GetParentFolderName(strFolder))
    End If
    fso.CreateFolder(strFolder)
End Sub

Function FolderExcluded(qFolder, qArray)
Dim q, LenFolder, LenArray, tmpStr
For q = 0 To UBound(qArray)
    If LCase(qArray(q)) = LCase(qFolder) Then
        FolderExcluded = True
        Exit Function
    Else
        LenFolder = Len(qFolder)
        LenArray = Len(qArray(q))
        If LenFolder > LenArray Then
            tmpStr = Mid(qFolder, 1, LenArray)
            If LCase(qArray(q)) = LCase(tmpStr) _
            And Mid(qFolder, Len(tmpStr)+1, 1) = "\" Then
                FolderExcluded = True
                Exit Function
            End If
        End if
    End If
Next 'q
    FolderExcluded = False
End Function

Function ExtraCount(ExtraFolderName, Counter)
Dim ExtraFolder, ExtraSubFolder, ExtraFile
    Set ExtraFolder = fso.GetFolder(ExtraFolderName)
'Подсчет числа файлов в корневом каталоге
    Counter = Counter + ExtraFolder.Files.Count
'Подсчет числа файлов в подкаталогах
    For Each ExtraSubFolder in ExtraFolder.SubFolders
        ExtraCount ExtraSubFolder.Path, Counter
    Next 'ExtraSubFolder
End Function

Function Conversion(ByteSize)
    if FormatNumber(ByteSize, 0) < 1024 Then
        Conversion = FormatNumber(ByteSize, 0) & "   байт"
    ElseIf FormatNumber(ByteSize/1024, 2) < 1024 Then
        Conversion = FormatNumber(ByteSize/1024, 2) & "   Кбайт"
    Else
        Conversion = FormatNumber(ByteSize/1024/1024, 2) & "   Мбайт"
    End If
End Function