Автоматический BACKuP 1С 8.2

[Amirzhan]

Здравствуйте, могите разобраться. скачал скрипт что бы делать на 8.2 автоматический архив базы, запускаем скрипт, работает, архив выгружен и потом выходит ошибка - скриншот не могу прикрепить, так что даю ссылку - http://i040.radikal.ru/1107/93/1872a10a2ac2.jpg. Что не так ?

[Amirzhan]

http://i040.radikal.ru/1107/93/1872a10a2ac2.jpg Что не так ?

[Amirzhan]

http://i040.radikal.ru/1107/93/1872a10a2ac2.jpg Что не так ?

После .jpg удалите точку и картинка загрузиться

[Amirzhan]

'********************************************************************
'* Скрипт для резервного копирования (выгрузки)
'* данных из базы данных 1С 7.7, 8.1 и 8.2
'*
'********************************************************************
Option Explicit                 ' Требуем обязательного объявления всех переменных

' Описание констант
Const DelOldFile = True      'возможность удаления устаревших архивных файлов
Const StackDepth = 10      'число дней хранения архивов баз
Const CopyReserve = True   'возможность ежемесячного резервного копирования (дублирования) архивных файлов                 'в отдельный каталог
Const User = True      'наличие зарегистрированного пользователя в системе, если таковых нет то False
Const EmailEndScript = True   'возможность отправки сообщений о каждом завершении работы скрапта на e-mail
Const Email = True      'возможность отправки предупреждающего сообщения об АВАРИЙНОМ ЗАВЕРШЕНИИ РАБОТЫ                'ПРОГРАММЫ на e-mail
' Значения для полей письма
Const EmailFrom = "admin@domain.ru"                  'адрес отправителя
Const EmailTo = "user@mail.ru"                   'адрес(а) получателя(ей)
                           '(несколько адресов через запятую)
Const EmailBodyPartCharSet = "utf-8"                        'кодовая страница сообщения
Const EmailSubject = "АВАРИЙНОЕ ЗАВЕРШЕНИЕ АРХИВАЦИИ БАЗ 1С"        'тема письма
Const EmailTextbody = "Подробная информация во вложенном log файле"   'тело письма
Const EmailAddAttachment = "F:\\BackUp1C\\BackUp1CBases.Log"      'вложение в письмо (ВНИМАНИЕ двойной \\)

' Описание переменных
Dim strLogFileName              ' Имя лог-файла
Dim BackUpFolder                ' "Корневая" папка для архивных коипий
Dim ReserveFolder               ' Дополнительная папка для хранения ежемесячных копий баз
Dim BasesList ()                ' Массив, содержащий список параметров архивируемых баз...
Dim MyBase                      ' Экземпляр объекта "база 1С"
Dim I                           ' Для циклов
Dim WshShell, oExec             ' Для запуска сторонних программ из скрипта
Dim S                           ' Для обработки текстовых величин
ReDim BasesList(0)              ' Очищаем массив, содержащий список параметров архивируемых баз

' Класс, описывающий свойства базы 1С
class Base1C
    Dim Type1C                  ' Тип 1С: 77 , 81 или 82
    Dim Program1CName           ' Имя исполняемого файла 1С
    Dim BaseLocationPath        ' Путь к базе данных 1С
    Dim BaseBackUpFolderName    ' Имя папки, где будут хранится архивы конкретной базы 1С
    Dim BaseBackUpFileName      ' Имя файла для архива базы (.dt или .zip) без расширения
    Dim UserName                ' Имя пользователя (обязательно)
    Dim UserPassword            ' Пароль пользователя (обязательно)   
      Private Sub class_Initialize()
             Type1C = ""
             Program1CName = ""
             BaseLocationPath = ""
             BaseBackUpFolderName = ""
             BaseBackUpFileName = ""
             UserName = ""
             UserPassword = ""
      End sub
End class
'********************************************************************
'********************************************************************
'********************************************************************
' Задаём параметры архивируемых баз данных (можно несколько)

' "Корневая" папка для архивных коипий
' Все остальные папки будут создаваться именно в этой корневой папке!!!
BackUpFolder = "E:\BackUp1C"

' Дополнительная папка для хранения ежемесячных копий баз
' Бужет создана, если константа CopyReserve = True
ReserveFolder  = "E:\BackUp1C\ReserveMonth\"

' Если имеем 2, 3 и более базы, следует скопировать данный блок столько раз,
' сколько баз необходимо заархивировать, не забыв изменить значения переменных

' Задаём параметры первой базы
Set MyBase = New Base1C
    ReDim Preserve BasesList(UBound(BasesList)+1)
        MyBase.Type1C = "81"
        MyBase.Program1CName = "C:\Program Files\1cv81\bin\1cv8.exe"
        MyBase.BaseLocationPath = "E:\Accounting"
        MyBase.BaseBackUpFolderName = "Бухгалтерия"
        MyBase.BaseBackUpFileName = "1Cv8Acc"
        MyBase.UserName = "Админ"
        MyBase.UserPassword = "admin"   
    Set BasesList(UBound(BasesList)) = MyBase
Set MyBase = Nothing

' Задаём параметры второй базы
Set MyBase = New Base1C
    ReDim Preserve BasesList(UBound(BasesList)+1)
        MyBase.Type1C = "82"
        MyBase.Program1CName = "C:\Program Files\1cv82\8.2.9.356\bin\1cv8.exe"
        MyBase.BaseLocationPath = "E:\1CBases\Small"
        MyBase.BaseBackUpFolderName = "Небольшая фирма"
        MyBase.BaseBackUpFileName = "1Cv8Small"
        MyBase.UserName = "Админ"
        MyBase.UserPassword = "admin"   
    Set BasesList(UBound(BasesList)) = MyBase
Set MyBase = Nothing
'********************************************************************
'********************************************************************
'********************************************************************
' Основной рабочий блок
'
' Задаём имя для лог-файла
strLogFileName = "BackUp1CBases.Log"
strLogFileName = ScriptPath + strLogFileName

AppendToFile strLogFileName, "НАЧАЛО"
AppendToFile strLogFileName, "Начинаем процесс автоматической архивации."
AppendToFile strLogFileName, "Лог пишется в файл " & vbTab & strLogFileName
AppendToFile strLogFileName, "Дата: " & vbTab & Date
AppendToFile strLogFileName, "Время: " & vbTab & Time
AppendToFile strLogFileName, " "
AppendToFile strLogFileName, "Ищем все запущенные экземпляры 1С v 8.x ..."
AppendToFile strLogFileName, "Найдено экземпляров 1С v 8.x: " & vbTab & ProcessCount ("1cv8%")

    If (ProcessCount ("1cv8%")) <> 0 Then
        AppendToFile strLogFileName, "Закрываем все экземпляры 1С v 8.x ..."
        KillProcess "1cv8%"
        AppendToFile strLogFileName, "Подождём секунд 5..."
        WScript.Sleep 5000
    End If

AppendToFile strLogFileName, "Продолжаем работу."
AppendToFile strLogFileName, " "
AppendToFile strLogFileName, "Ищем все запущенные экземпляры 1С v 7.7 ..."
AppendToFile strLogFileName, "Найдено экземпляров 1С v 7.7: " & vbTab & ProcessCount ("1cv7%")

    If (ProcessCount ("1cv7%")) <> 0 Then
        AppendToFile strLogFileName, "Закрываем все экземпляры 1С v 7.7 ..."
        KillProcess "1cv7%"
        AppendToFile strLogFileName, "Подождём секунд 5..."
        WScript.Sleep 5000
    End If

AppendToFile strLogFileName, "Продолжаем работу."
AppendToFile strLogFileName, " "
AppendToFile strLogFileName, "Проверяем существование корневой папки для архивов"

FolderCreate BackUpFolder
If Not FolderExist (BackUpFolder) then
    AppendToFile strLogFileName, "Корневой папки не существует, и создать её не удалось!!!"
    AppendToFile strLogFileName, "АВАРИЙНОЕ ЗАВЕРШЕНИЕ РАБОТЫ ПРОГРАММЫ!!!"
    SendEmail
    WScript.Quit
End If

AppendToFile strLogFileName, "Папка нашлась."
AppendToFile strLogFileName, "Продолжаем работу."
AppendToFile strLogFileName, " "
AppendToFile strLogFileName, "Количество архивируемых баз = " & UBound(BasesList)
AppendToFile strLogFileName, " "

For I = 1 To UBound(BasesList)
    AppendToFile strLogFileName, "Обрабатывается база № " & I
    AppendToFile strLogFileName, "Тип базы: " & BasesList(I).Type1C
    AppendToFile strLogFileName, "Имя исполняющего файла 1С: " & BasesList(I).Program1CName
    AppendToFile strLogFileName, "Исходное расположение базы: " & BasesList(I).BaseLocationPath
    AppendToFile strLogFileName, "Папка для архивной копии: " & BasesList(I).BaseBackUpFolderName
    AppendToFile strLogFileName, "Имя файла для архивной копии: " & BasesList(I).BaseBackUpFileName
    AppendToFile strLogFileName, "Имя пользователя: " & BasesList(I).UserName
    AppendToFile strLogFileName, "Пароль пользователя: " & BasesList(I).UserPassword
    AppendToFile strLogFileName, " "

    Select Case BasesList(I).Type1C
        Case "77"
            BackUp77
        Case "81"
            BackUp81
        Case "82"
            BackUp81
        Case Else   
         AppendToFile strLogFileName, "Неизвестный тип базы 1С!"
    End Select
   
    AppendToFile strLogFileName, " "
    AppendToFile strLogFileName, "Закончили обработку базы № " & I
    AppendToFile strLogFileName, " "
Next

ShowFreeSpace(BackUpFolder)
AppendToFile strLogFileName, " "
AppendToFile strLogFileName, " "
AppendToFile strLogFileName, "Архивация закончена."
AppendToFile strLogFileName, "Дата:" & vbTab & Date
AppendToFile strLogFileName, "Время:" & vbTab & Time
AppendToFile strLogFileName, "КОНЕЦ"
AppendToFile strLogFileName, " "
If EmailEndScript Then
    SendEmail
End If
WScript.Quit
'********************************************************************
'*
'*  Процедура   : AppendToFile
'*  Описание    : Дописывает в файл текстовую информацию
'*  Вход        : strFileName - имя файла, в который нужно дописать информацию
'*                strString   - дописываемая информация
'*
'********************************************************************
Sub AppendToFile(ByVal strFileName, ByVal strString)
Const ForAppending = 8
Dim fso, f
    Err.Clear
    On Error Resume Next

    Set fso = CreateObject("Scripting.FileSystemObject")
        Set f = fso.OpenTextFile(strFileName, ForAppending, True)
            f.WriteLine strString
            f.Close
        Set f = Nothing
    Set fso = Nothing
End Sub
'********************************************************************
'*
'*  Функция   : ScriptPath
'*  Описание  : Возвращает имя папки, в которой находится скрипт
'*  Вход      : нет
'*  Выход     : имя папки, в которой находится скрипт
'*
'********************************************************************
Function ScriptPath
Dim S
    Err.Clear
    On Error Resume Next   

    ScriptPath = ""
    S = WScript.ScriptFullName
    ScriptPath = mid(S,1,instrrev(S,"\"))
End Function
'********************************************************************
'*
'*  Функция   : ProcessCount
'*  Описание  : Возвращает количество запущенных экземпляров процесса с указанным именем
'*  Вход      : PName - имя процесса
'*  Выход     : число запущенных процессов
'*
'********************************************************************
Function ProcessCount (ByVal PName)
Dim N, objService, objProc   
    Err.Clear
    On Error Resume Next
   
    ProcessCount = 0
    N = 0
   
    Set objService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2")
   
    If Err.Number <> 0 Then
        AppendToFile strLogFileName, "ПРОИЗОШЛА ОШИБКА!!!"
        AppendToFile strLogFileName, Err.Number & ": " & Err.Description
        AppendToFile strLogFileName, "АВАРИЙНОЕ ЗАВЕРШЕНИЕ РАБОТЫ ПРОГРАММЫ!!!"
   SendEmail       
   WScript.Quit
    End If
    For Each objProc In objService.ExecQuery("SELECT * FROM Win32_Process WHERE Name like  '" & PName & "'")
        N = N +1
    Next
   
    ProcessCount = N
End Function
'********************************************************************
'*
'*  Процедура : KillProcess
'*  Описание  : Выгружает из памяти все экземпляры процесса с указанным именем
'*  Вход      : PName - имя процесса
'*    Выход      : нет
'*

[Amirzhan]

'********************************************************************
Function KillProcess (ByVal PName)
Dim objService, objProc
   Err.Clear
   On Error Resume Next
   
   Set objService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\CIMV2")
   
   If Err.Number <> 0 Then
       AppendToFile strLogFileName, "ПРОИЗОШЛА ОШИБКА!!!"
       AppendToFile strLogFileName, Err.Number & ": " & Err.Description
       AppendToFile strLogFileName, "АВАРИЙНОЕ ЗАВЕРШЕНИЕ РАБОТЫ ПРОГРАММЫ!!!"
   SendEmail        
   WScript.Quit
   End If
   For Each objProc In objService.ExecQuery("SELECT * FROM Win32_Process WHERE Name like  '" & PName & "'")
       objProc.Terminate
   Next
End Function
'********************************************************************
'*
'*  Функция   : MyFileExist
'*  Описание  : Функция проверки существования файла
'*  Вход      : Имя файла
'*  Выход     : true, если файл существует, и false, если файл отсутствует.
'*
'********************************************************************
Function MyFileExist (ByVal FileName)
dim fso
   Err.Clear
   On Error Resume Next
   
   Set fso = WScript.CreateObject("Scripting.FileSystemObject")
       MyFileExist = (fso.FileExists(FileName))
   Set fso = Nothing
end Function
'********************************************************************
'*
'*  Функция   : FolderExist
'*  Описание  : Функция проверки существования папки
'*  Вход      : Имя папки
'*  Выход     : true, если папка существует, и false, если папка отсутствует.
'*
'********************************************************************
Function FolderExist (ByVal FolderName)
dim fso
   Err.Clear
   On Error Resume Next
   
   Set FSO = CreateObject("Scripting.FileSystemObject")
       FolderExist = (FSO.FolderExists(FolderName))
   Set fso = Nothing
end Function
'********************************************************************
'*
'*  Функция   : FolderCreate
'*  Описание  : Функция создания папки по нужному пути
'*  Вход      : Полный путь к создаваемой папке.
'*  Выход     : нет
'*
'********************************************************************
Sub FolderCreate (ByVal FolderName)
Dim objFSO, objFolder
Dim FA, FN, I
   Err.Clear
   On Error Resume Next
   
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   FA = Split(FolderName, "\")
   FN = FA (0)
   
   For I = 1 To UBound(FA)
       If Len (FA (I)) <> 0 Then
           FN = FN & "\" &  FA (I)
           Err.Clear
           Set objFolder = objFSO.CreateFolder(FN)
           Set objFolder = Nothing
           AppendToFile strLogFileName, FN & " - " & Err.Description
       End If
   Next
end Sub
'********************************************************************
'*
'*  Функция   : GetFolder
'*  Описание  : Функция получить папку
'*  Вход      : Полное имя папки
'*  Выход     : нет
'*
'********************************************************************
Function GetFolder (sFolder)
Dim fso
   Err.Clear
   On Error Resume Next

   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set GetFolder = FSO.GetFolder(sFolder)
   if err.number <> 0 then
   WScript.Echo "Error Opening folder " & sFolder & VBlf & "["&Err.Description&"]"
   Wscript.Quit Err.number
   end if
End Function
'********************************************************************
'*
'*  Функция   : GetFile
'*  Описание  : Функция получить файл
'*  Вход      : Полное имя файла
'*  Выход     : нет
'*
'********************************************************************
Function GetFile(sFile)
dim fso
   Err.Clear
   On Error Resume Next

   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set GetFile = FSO.GetFile(sFile)
   if err.number <> 0 then
   WScript.Echo "Error Opening file " & sFile & VBlf & "["&Err.Description&"]"
   Wscript.Quit Err.number
   end if
End Function
'********************************************************************
'*
'*  Функция   : ReadTextFromFile
'*  Описание  : Функция возвращает весь текст из указанного файла
'*  Вход      : Полное имя файла
'*  Выход     : текст, содержащийся в файле
'*
'********************************************************************
Function ReadTextFromFile (byval FileName)
Dim objFSO, objTextFile
Const ForReading = 1
   Err.Clear
   On Error Resume Next
   
   Set objFSO = CreateObject("Scripting.FileSystemObject")
       Set objTextFile = objFSO.OpenTextFile(FileName, ForReading)
           ReadTextFromFile = objTextFile.ReadAll
       Set objTextFile = Nothing
   Set objFSO = Nothing
end Function
'********************************************************************
'*
'*  Функция   : DeleteFile
'*  Описание  : Функция удаления файла
'*  Вход      : Полное имя файла
'*  Выход     : нет
'*
'********************************************************************
Function DeleteFile (byval FileName)
Dim objFSO
   Err.Clear
   On Error Resume Next

   Set objFSO = CreateObject("Scripting.FileSystemObject")
       objFSO.DeleteFile FileName, True
   Set objFSO = Nothing
' Пауза в 20 милисекунд
   WScript.Sleep 20
end Function
'********************************************************************
'*
'*  Функция   : CopyFile
'*  Описание  : Функция копирования файла
'*  Вход      : Полное имя файла
'*  Выход     : нет
'*
'********************************************************************
Sub CopyFile (byval FileName, byval FolderName)
Dim objFSO
   Err.Clear
   On Error Resume Next

   Set objFSO = CreateObject("Scripting.FileSystemObject")
       objFSO.CopyFile FileName, FolderName, False
   Set objFSO = Nothing
' Пауза в 20 милисекунд
   WScript.Sleep 20
end Sub
'********************************************************************
'*
'*  Функция   : ReserveOlderFiles
'*  Описание  : Функция копирования последнего архивного файла прошедшего месяца в другой каталог
'*  Вход      : Полное имя папки
'*  Выход     : нет
'*
'********************************************************************
Sub ReserveOlderFiles(FolderName)
Dim objDir
Dim fso
Dim efile
Dim eFilesCollection
Dim j
Dim FilePathArray ()
Dim FileDateArray ()
Dim LastFilePath
Dim LastFileDate
Dim AgeFileMonth
   
   AppendToFile strLogFileName, "Проверяем наличие папки для хранения ежемесячных копий..."
   FolderCreate ReserveFolder
   If Not FolderExist (ReserveFolder) then
       AppendToFile strLogFileName, "Папки для хранения ежемесячных копий баз 1С не существует, и создать её не удалось!!!"
       AppendToFile strLogFileName, "АВАРИЙНОЕ ЗАВЕРШЕНИЕ РАБОТЫ ПРОГРАММЫ!!!"
       SendEmail
       WScript.Quit
   End If    

   AppendToFile strLogFileName, "Папка для хранения ежемесячных копий баз 1С нашлась."
       
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Set objDir = GetFolder(FolderName)
   Set eFilesCollection = objDir.Files   
   
   ReDim FilePathArray (eFilesCollection.Count)
   ReDim FileDateArray (eFilesCollection.Count)
   j = 0

' просматриваем все файлы в директории и отбираем файлы предыдущего месяца
   For each efile in eFilesCollection
       AgeFileMonth = Month(Date)-Month(efile.DateLastModified)
   If AgeFileMonth = 1 Then
      j = j + 1      
          FilePathArray (j) = efile.Path
      FileDateArray (j) = efile.DateLastModified
   End If
   next

   If j <> 0 Then
' определяем файл с последней созданной версией баз
   For j = 1 To UBound(FilePathArray)
       If FileDateArray (j) > LastFileDate Then
           LastFilePath = FilePathArray (j)
           LastFileDate = FileDateArray (j)
           End If
       next

   If MyFileExist (ReserveFolder & fso.GetFileName(LastFilePath)) Then
           AppendToFile strLogFileName, "Файл архива: " & fso.GetFileName(LastFilePath) & " был скопирован ранее. Резервирование сейчас не требуется!"
   Else
       CopyFile LastFilePath, ReserveFolder
       If Err.Number = 0 Then
           AppendToFile strLogFileName, "Файл архива: " & fso.GetFileName(LastFilePath) & " был успешно скопирован!"
       End If
   End If
   Else
   AppendToFile strLogFileName, "Резервирование не требуется! Ждем окончания месяца."   
   End If
   
End Sub         
'********************************************************************
'*
'*  Функция   : DeleteOlderFiles
'*  Описание  : Функция удаления файлов старше заданного количества дней
'*  Вход      : Полное имя папки
'*  Выход     : нет
'*

[Amirzhan]

'********************************************************************
Sub DeleteOlderFiles(FolderName, StackDepth)
Dim objDir
Dim fso
Dim FileDate
Dim efile
Dim Age
Dim k
    Err.Clear
    On Error Resume Next

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objDir = GetFolder(FolderName)

' просматриваем все файлы в заданной директории
    For each efile in objDir.Files      
        FileDate = efile.DateLastModified
   Age = DateDiff("d",Now,FileDate)      
      If Abs(Age)>StackDepth Then
         DeleteFile(efile)
         k = k + 1
      End If      
    next
   
    If Err.Number = 0 Then
       If k = 0 Then AppendToFile strLogFileName, "Устаревших файлов не обнаружено"   
       If k = 1 Then AppendToFile strLogFileName, "Успешно удален " & k & " устаревший файл"   
       If k > 1 and k < 5 Then AppendToFile strLogFileName, "Успешно удалены " & k & " устаревших файла"
       If k => 5 Then AppendToFile strLogFileName, "Успешно удалены " & k & " устаревших файлов"
    End If
End Sub
'*'********************************************************************
'*
'*  Функция   : ShowFreeSpace
'*  Описание  : Процедура определяет свободное место на диске
'*  Вход      : Нет
'*  Выход     : нет
'*
'********************************************************************
Function ShowFreeSpace(drvPath)
   Dim fso, objDrive
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set objDrive = fso.GetDrive(fso.GetDriveName(drvPath))
   S = "Диск " & UCase(objDrive) & " - "
   S = S & objDrive.VolumeName  & " / "
   S = S & "Своббодно: " & FormatNumber(objDrive.FreeSpace/1024/1024, 0)
   S = S & " Мбайт"
   AppendToFile strLogFileName, "ВНИМАНИЕ!!!  Проверяем наличие свободного места на диске для архивных копий..."
   AppendToFile strLogFileName, S
End Function
'*'********************************************************************
'*
'*  Функция   : SendEmail
'*  Описание  : Функция отправки e-mail с компьютера, где установлен локальный SMTP-сервис/сервер
'*  Вход      : Нет
'*  Выход     : нет
'*
'********************************************************************
Sub SendEmail
Dim objEmail

    If    Email Then
   AppendToFile strLogFileName, " "
   AppendToFile strLogFileName, "Отправлено предупреждающее сообщение на e-mail."
   AppendToFile strLogFileName, "Дата:" & vbTab & Date
   AppendToFile strLogFileName, "Время:" & vbTab & Time
   AppendToFile strLogFileName, "КОНЕЦ"
   AppendToFile strLogFileName, " "

   Set objEmail = CreateObject("CDO.Message")           'создаем объект CDO.Message
   objEmail.From = EmailFrom
   objEmail.To = EmailTo
   objEmail.BodyPart.CharSet = EmailBodyPartCharSet
   IF EmailEndScript Then
       objEmail.Subject = "Работа скрипта успешно завершена !!!"
   Else
       objEmail.Subject = EmailSubject
   End If
   objEmail.Textbody = EmailTextbody
       objEmail.AddAttachment(EmailAddAttachment)
'   objEmail.Send()
   Set objEmail= nothing
    End If
End Sub         
'********************************************************************
'* Функция выгрузки баз 1С 8.1
'********************************************************************
Sub BackUp81
Dim FullPathBaseBackUpFolder

    FullPathBaseBackUpFolder = BackUpFolder & "\" & BasesList(I).BaseBackUpFolderName

    If BasesList(I).Type1C = 81 Then       
       AppendToFile strLogFileName, "Определили, что тип базы 1С v 8.1"
    Else
       AppendToFile strLogFileName, "Определили, что тип базы 1С v 8.2"    
    End If

         AppendToFile strLogFileName, "Проверяем наличие папки для хранения архивной копии..."
         FolderCreate FullPathBaseBackUpFolder
         
         If Not FolderExist (FullPathBaseBackUpFolder) then
                AppendToFile strLogFileName, "Папки для хранения архивной копии не существует, и создать её не удалось!!!"
                AppendToFile strLogFileName, "АВАРИЙНОЕ ЗАВЕРШЕНИЕ РАБОТЫ ПРОГРАММЫ!!!"
                SendEmail
      WScript.Quit
         End If
           
         AppendToFile strLogFileName, "Папка нашлась."
         AppendToFile strLogFileName, " "
         AppendToFile strLogFileName, "Проверяем наличие папки с информационной базой 1С..."

         If Not FolderExist (BasesList(I).BaseLocationPath) then
                AppendToFile strLogFileName, "Папка с информационной базой не обнаружена, нет объекта для резервирования!!!"
                AppendToFile strLogFileName, "АВАРИЙНОЕ ЗАВЕРШЕНИЕ РАБОТЫ ПРОГРАММЫ!!!"
                SendEmail
      WScript.Quit
         End If
           
         AppendToFile strLogFileName, "Папка с информационной базой нашлась."
         AppendToFile strLogFileName, "Продолжаем работу."
         AppendToFile strLogFileName, " "
         
    If BasesList(I).Type1C = 81 Then       
       AppendToFile strLogFileName, "Подготавливаем строку для запуска 1С v 8.1"
    Else
       AppendToFile strLogFileName, "Подготавливаем строку для запуска 1С v 8.2"    
    End If
         
    If User Then
      S = """" & BasesList(I).Program1CName & """ CONFIG /DumpIB """ & FullPathBaseBackUpFolder & "\" & BasesList(I).BaseBackUpFileName & " " & Replace(cstr(now()), ":", ".") & ".dt"" /F""" & BasesList(I).BaseLocationPath & """ /n" & BasesList(I).UserName & " /p" & BasesList(I).UserPassword & " /wa- /Out""" & FullPathBaseBackUpFolder & "\dump.log"" -NoTruncate "
    Else
      S = """" & BasesList(I).Program1CName & """ CONFIG /DumpIB """ & FullPathBaseBackUpFolder & "\" & BasesList(I).BaseBackUpFileName & " " & Replace(cstr(now()), ":", ".") & ".dt"" /F""" & BasesList(I).BaseLocationPath & """ /wa- /Out""" & FullPathBaseBackUpFolder & "\dump.log"" -NoTruncate "
    End If
         AppendToFile strLogFileName, "Строка для запуска 1С получилась следующая:"
         AppendToFile strLogFileName, S
         
         AppendToFile strLogFileName, "Запускаем 1C в пакетном режиме..."
         
         Set WshShell = CreateObject("WScript.Shell")
      oExec = WshShell.run( S, 5 , True)
         Set WshShell = Nothing
           
         AppendToFile strLogFileName, "Отчёт самой программы 1С о выгрузке базы следующий:"
           
         AppendToFile strLogFileName, ReadTextFromFile ( BackUpFolder & "\" & BasesList(I).BaseBackUpFolderName & "\dump.log")
         
         AppendToFile strLogFileName, "Удалим файл с отчётом 1С с диска компьютера..."
         DeleteFile (FullPathBaseBackUpFolder & "\dump.log")
         If Err.Number = 0 Then
      AppendToFile strLogFileName, "Файл с отчётом 1С успешно удалён!"
         Else
      AppendToFile strLogFileName, "Файл с отчётом 1С удалить не удалось!"
         End If
         AppendToFile strLogFileName, " "

         AppendToFile strLogFileName, "Переходим к резервному копированию месячных копий баз 1С..."
    If CopyReserve Then
      Call ReserveOlderFiles(FullPathBaseBackUpFolder)
    Else
            AppendToFile strLogFileName, "Ежемесячное копирование баз 1С не выбрано"
         End If
         AppendToFile strLogFileName, " "

         AppendToFile strLogFileName, "Переходим к удалению устаревших копий баз 1С..."
    If DelOldFile Then
      Call DeleteOlderFiles(FullPathBaseBackUpFolder, StackDepth)
    Else
            AppendToFile strLogFileName, "Удаление устаревших копий баз 1С не выбрано"
         End If

End Sub
'********************************************************************
'* Функция выгрузки баз 1С 7.7
'********************************************************************
Sub BackUp77
Dim FullPathBaseBackUpFolder
Dim MyFileName
Dim MyLogName
Dim MyPRMFile
dim fso
Dim S                         
    FullPathBaseBackUpFolder = BackUpFolder & "\" & BasesList(I).BaseBackUpFolderName
         AppendToFile strLogFileName, "Определили, что тип базы 1С v 7.7"
         AppendToFile strLogFileName, "Проверяем наличие папки для хранения архивной копии..."
         FolderCreate FullPathBaseBackUpFolder
         
         If Not FolderExist (FullPathBaseBackUpFolder) then
                AppendToFile strLogFileName, "Папки для хранения архивной копии не существует, и создать её не удалось!!!"
                AppendToFile strLogFileName, "АВАРИЙНОЕ ЗАВЕРШЕНИЕ РАБОТЫ ПРОГРАММЫ!!!"
                SendEmail
      WScript.Quit
            End If
           
         AppendToFile strLogFileName, "Папка нашлась."
         AppendToFile strLogFileName, " "
         AppendToFile strLogFileName, "Проверяем наличие папки с информационной базой 1С..."

         If Not FolderExist (BasesList(I).BaseLocationPath) then
                AppendToFile strLogFileName, "Папка с информационной базой не обнаружена, нет объекта для резервирования!!!"
                AppendToFile strLogFileName, "АВАРИЙНОЕ ЗАВЕРШЕНИЕ РАБОТЫ ПРОГРАММЫ!!!"
                SendEmail
      WScript.Quit
            End If
           
         AppendToFile strLogFileName, "Папка с информационной базой нашлась."
         AppendToFile strLogFileName, "Продолжаем работу."
         AppendToFile strLogFileName, " "
         
         AppendToFile strLogFileName, "Подготавливаем файл с параметрами для запуска 1С v 7.7"
         AppendToFile strLogFileName, "Вычислим имя для пакетного файла."
   
         MyFileName =  FullPathBaseBackUpFolder & "\1CBackUp.prm"
         
         AppendToFile strLogFileName, "Имя получилось следующим: " & MyFileName
         AppendToFile strLogFileName, "Запишем в файл нужные параметры:"
         AppendToFile strLogFileName, " "
           
                Set fso = WScript.CreateObject("Scripting.FileSystemObject")
                Set MyPRMFile =fso.CreateTextFile(MyFileName, True)
           
                    ' Вычислим имя для log-файла 1С
                    MyLogName = FullPathBaseBackUpFolder & "\1C_Log_File.txt"
               
                    ' Запись текста в пакетный файл
                    MyPRMFile.WriteLine("[General]")
                    MyPRMFile.WriteLine("Output = """ & MyLogName & """" )
                    MyPRMFile.WriteLine("Quit = 1")
                    MyPRMFile.WriteLine("CheckAndRepair = 0")
                    MyPRMFile.WriteLine("UnloadData = 1")
                    MyPRMFile.WriteLine("SaveData = 0")
                    MyPRMFile.WriteLine("AutoExchange = 0")
                    MyPRMFile.WriteLine("")
                    MyPRMFile.WriteLine("[UnloadData]")
                    MyPRMFile.WriteLine("UnloadToFile = """ & FullPathBaseBackUpFolder & "\" & BasesList(I).BaseBackUpFileName & " " & Replace(cstr(now()), ":", ".") & ".zip""")
                    MyPRMFile.WriteLine("IncludeUserDef = 1")
                    MyPRMFile.WriteLine("Password =")
               
                    MyPRMFile.Close
           
                Set MyPRMFile = Nothing
                Set fso = Nothing
       
         AppendToFile strLogFileName, ReadTextFromFile (MyFileName)
                 
         AppendToFile strLogFileName, "Подготавливаем строку для запуска 1С v 7.7"
         
    If User Then
            S = """" & BasesList(I).Program1CName & """ config /d""" & BasesList(I).BaseLocationPath & """ /n""" & BasesList(I).UserName & """ /p""" & BasesList(I).UserPassword & """ /@""" & MyFileName & """"
    Else
            S = """" & BasesList(I).Program1CName & """ config /d""" & BasesList(I).BaseLocationPath & """ /@""" & MyFileName & """"
    End If

         AppendToFile strLogFileName, "Строка для запуска 1С получилась следующая:"
         AppendToFile strLogFileName, S
         
         AppendToFile strLogFileName, "Запускаем 1C в пакетном режиме..."
         
            Set WshShell = CreateObject("WScript.Shell")
                oExec = WshShell.run( S, 5 , True)
            Set WshShell = Nothing
           
            AppendToFile strLogFileName, "Отчёт самой программы 1С о выгрузке базы следующий:"
           
            AppendToFile strLogFileName, ReadTextFromFile ( MyLogName)
         
         AppendToFile strLogFileName, "Удалим файл с отчётом 1С с диска компьютера..."
         DeleteFile ( MyLogName)
         
         If Err.Number = 0 Then
             AppendToFile strLogFileName, "Файл с отчётом 1С успешно удалён!"
         Else
             AppendToFile strLogFileName, "Файл с отчётом 1С удалить не удалось!"
         End If
         AppendToFile strLogFileName, " "   
   
         AppendToFile strLogFileName, "Удалим файл параметров выгрузки базы 1С с диска компьютера..."
         DeleteFile ( MyFileName)
         
         If Err.Number = 0 Then
             AppendToFile strLogFileName, "Файл параметров выгрузки базы 1С успешно удалён!"
         Else
             AppendToFile strLogFileName, "Файл параметров выгрузки базы 1С удалить не удалось!"
         End If       
         AppendToFile strLogFileName, " "

         AppendToFile strLogFileName, "Переходим к резервному копированию месячных копий баз 1С..."
    If CopyReserve Then
      Call ReserveOlderFiles(FullPathBaseBackUpFolder)
    Else
            AppendToFile strLogFileName, "Ежемесячное копирование баз 1С не выбрано"
         End If
         AppendToFile strLogFileName, " "         

         AppendToFile strLogFileName, "Переходим к удалению устаревших копий баз 1С..."
    If DelOldFile Then
      Call DeleteOlderFiles(FullPathBaseBackUpFolder, StackDepth)
    Else
            AppendToFile strLogFileName, "Удаление устаревших копий баз 1С не выбрано"
         End If

End Sub

[Amirzhan]

Кто поможет  ? Буду рад, просто реально бывает нужно )))

[maloy]

ты п ещё кинул ссылку на на весь скрипт целиком...
Вот мне нефиг делать, сидеть его клеить из разных постов, а потом искать там 601-ую строку.

Буквально пишет, что неправильно задан путь.
Какой путь? Разбирайся сам. Может путь к исполняемому файлу платформы, может путь к базе, может путь к каталогу бекапа.

[Amirzhan]

ты п ещё кинул ссылку на на весь скрипт целиком...
Вот мне нефиг делать, сидеть его клеить из разных постов, а потом искать там 601-ую строку.

Буквально пишет, что неправильно задан путь.
Какой путь? Разбирайся сам. Может путь к исполняемому файлу платформы, может путь к базе, может путь к каталогу бекапа.

Извини ))) вот ссылка ftp://aty.dyndns-office.com/user/workscript.vbs

[Amirzhan]

логин и пароль user