Резервное копирование папки с файлами xls (Excel 2003)

[EducatedFool]

Насколько я знаю, WinRAR поддерживает создание архивов RAR и ZIP (ну и ещё SFX)
Архив 7z он создать не может.

А чем не устраивает ZIP и RAR?
Степень сжатия почти не отличается...

PS: ZIP можно создать и без использования внешней программы (WinRAR) - средствами Windows. (но код будет сложнее)

[vfv]

Пусть будет Архив ZIP.

Вот я нашёл ещё ваш макрос:

Sub Zip_thisWorkbook()
DefPath = "e:\"
'Create date/time string and the temporary xls/zip file names
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & strDate & ".zip"
FileNameXls = DefPath & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4) & strDate & ".xls"
If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then
'Make copy of the thisWorkbook
ThisWorkbook.SaveCopyAs FileNameXls 'Create empty Zip File
NewZip (FileNameZip) 'Copy the file in the compressed folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameZip).CopyHer e FileNameXls 'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).Items.C ount = 1
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End If
Kill FileNameXls ' удаляем временно созданный файл Excel
MsgBox "Создан архив: " & FileNameZip, vbInformation, "Готово"
'Set fs = CreateObject("Scripting.FileSystemO bject"): 'fs.MoveFile FileNameZip, "d:\"
End Sub

Sub NewZip(sPath)
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub

Но как прикрутить его к ранее созданному вами макросу для меня очень сложно.

Может поможете сегодня в последний раз.