On Error Resume Next 'внимание! эту строку закомментировать на время отладки!
'*************************************************
'Блок переменных
'*************************************************
'Класс, описывающий свойства базы 1С
class Base1C
    Dim BaseName        'Имя базы
    Dim BasePath        'Путь к базе данных 1С (каталог без \ на конце)
End class

Dim BasesList() 'Массив всех баз
Dim MyBase
Dim LogStream
Const LogPath 		= "\\server1\logs\log_backups.log" 'путь к лог-файлу
Const TempPath		= "\\server1\temp_folder_backups" 'временный каталог
Const BackupsPath	= "\\server2\backup\FILE_BASE" 'каталог хранилище бэкапов
Const RarPath		= "C:\Program Files (x86)\AutoBackups\Rar.exe" 'путь к архиватору
Const BlatPath		= "C:\Program Files (x86)\AutoBackups\blat.exe" 'путь к программе отправки сообщений

Set objFSO 			= CreateObject("Scripting.FileSystemObject")	
Set LogStream 		= objFSO.OpenTextFile(LogPath, 8, True)
ReDim BasesList(0)


'*************************************************
'Блок заполнения списка баз
'*************************************************
'_______________
'server server1
AddBase BasesList, "BP_base1", "\\server1\1C\BP_base1"
AddBase BasesList, "BP_base2", "\\server1\1C\BP_base2"
'_______________
'server server3
AddBase BasesList, "BASE3", "\\server3\bases\BASE3"


'*************************************************
'Основной функционал
'*************************************************
'_______________
PrintToLog "Начало операции резервного копирования баз 1С", true, true
For I = 0 To UBound(BasesList)-1
	Set MyBase = BasesList(I)
	PrintToLog CStr(I) & ". Добавление в архив базы " & MyBase.BaseName & ", путь: "  & MyBase.BasePath, false, true
	FilesList = CopyFilesBase(MyBase.BasePath,MyBase.BaseName)
	AddToArhive FilesList, MyBase.BaseName
	'WScript.echo "был: "+CStr(I)+" \ "+CStr(UBound(BasesList))+", "+MyBase.BaseName	
Next
SendMail()
LogStream.Close


Function SendMail()
	dim Comand,t_subject,t_body
	'blat -body "TEST" -to test@yandex.ru -server smtp.mail.ru -f test@mail.ru -u test@mail.ru -pw пароль
	Set WshShell = WScript.CreateObject("WScript.Shell")
	t_subject = "Backups 1c bases 1CD "+CStr(Now)
	t_body = t_subject
	Comand = Chr(34)+BlatPath+Chr(34) +" -body "+Chr(34)+t_body+Chr(34)+" -subject "+Chr(34)+t_subject+Chr(34)+" -to mailXXXX@yandex.ru -server smtp.yandex.ru -port 25 -f mailXXXX@yandex.ru -u mailXXXX@yandex.ru -pw pasXXXX"+" -attach "+LogPath
	WshShell.Run Comand
End Function

Sub AddToArhive(FilesList, BaseName)
	dim NewFileName, Comand, I	
	Set WshShell = WScript.CreateObject("WScript.Shell")	
	'WSHell.Run "7z a -tzip D:\backup\1C\1SBDB\rab"+daydate+".zip -r e:\base\1cv77\1sbdb\* -x!*.cdx", 2, true
	For I = 0 To UBound(FilesList)-1
		FileName = FilesList(I) 'содержит копии файлов которые надо архивировать
		NewFileName = BackupsPath & "\" & BaseName & "_backup_" & Date & ".rar"
		Comand = Chr(34)+RarPath+Chr(34) +" m "+NewFileName+" -m1 -ep -rr "+FileName 'команда архивирования с удалением исходного файла
		PrintToLog Comand, false, true
		WshShell.Run Comand, 1, 1
	Next
End Sub

Function CopyFilesBase(Folder,BaseName)
	Dim NewFileName
	Dim FilesList()
	ReDim FilesList(0)	
	Set ResFSO = CreateObject("Scripting.FileSystemObject")
	Set ResFolder = ResFSO.GetFolder(Folder)
	For Each File In ResFolder.Files
		if File.Name = "1Cv8.1CD" or File.Name = "1cv8ddb.1CD" then
			NewFileName = "" & TempPath & "\" & BaseName & "_" & File.Name
			ResFSO.CopyFile Folder & "\" & File.Name, NewFileName
			ReDim Preserve FilesList(UBound(FilesList)+1)
			FilesList(UBound(FilesList)-1) = NewFileName
		end if
	Next	
	CopyFilesBase = FilesList
End Function

Sub AddBase(BasesList,Name,Path)
	Set MyBase = New Base1C
		ReDim Preserve BasesList(UBound(BasesList)+1)
		MyBase.BaseName = Name
		MyBase.BasePath = Path  
		Set BasesList(UBound(BasesList)-1) = MyBase
		Set MyBase = Nothing
End Sub

Sub PrintToLog(StrLog,AddSep,AssTime)
	if AddSep=true then
		LogStream.WriteLine "============="
	end if
	Str = ""
	if AssTime=true then
		Str = ""&Time&": "
	end if
	Str = Str&StrLog
	LogStream.WriteLine Str
End Sub