kazavo4ka
Advanced Member | Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
'показываем пользователю окошки с надписями
set wshShell= Wscript.CreateObject("WScript.Shell")
intButton = wshShell.Popup ("Инициализированна процедура обмена данными между 1С 8 УАТ и 1С 8 УПП" & vbCrLf & _
" " & vbCrLf & _
"В зависимости от объема данных/загруженности сервера и т.д. обработка может длиться от 5 до 20+ минут"& vbCrLf & _
" "& vbCrLf & _
"Запускаем?", 0, _
"1С", 64+4)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objReadFile = objFSO.OpenTextFile("\\fileserver\1c\temp\email_adresses.txt", 1)
strEmailAdress = objReadFile.ReadAll
Sub Procedure1
'запускаем 1С с нужными параметрами
wshshell.Run """c:\Program Files (x86)\1cv82\8.2.13.219\bin\1cv8.exe"" ENTERPRISE /DisableStartupMessages /WA- /Sserver1C\uat /NАдминистрированиеИБ /Pole /CОбменУАТУПП", 1, True
wshshell.Run """c:\Program Files (x86)\1cv82\8.2.13.219\bin\1cv8.exe"" ENTERPRISE /DisableStartupMessages /WA- /Sserver1c\upp /NАдминистрированиеИБ /Pole /CОбменУАТУПП", 1, True
'снова показываем пользователю окошки с надписями
set wshShell= Wscript.CreateObject("WScript.Shell")
wshShell.Popup "Обмен данными завершен" & vbCrLf & _
" " & vbCrLf & _
"Результат будет выслан вам по эл.почте после нажатия кнопки ОК", 60, _
"1С", 64
'находим отображаемое в AD DS имя пользователя (ФИО) и объявлеям его переменной, чтобы потом в письмо вставить
Set objADSystemInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objADSystemInfo.UserName)
FullUserName = objUser.displayName
'находим текстовые файл в заданной папке и объявлеям их переменной, чтобы потом в письмо вставить, а затем переместить в архивную папку
Const PATH = "\\fileserver\1c\temp\exchange_files"
Const DEST = "\\fileserver\1c\temp\Отчеты об обмене (архив)\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(PATH)
Set oFiles= oFolder.files
'процедура формирования и отправки письма
sBody = "Прикрепленный к письму файл содержит подробный реестр проблемных документов при загрузке из УАТ в УПП" & VbCrLf
sBody = sBody & " "& VbCrLf
sBody = sBody & "Обмен данными был инициализирован пользователем " & FullUserName & "" & VbCrLf
sBody = sBody & " "& VbCrLf
sBody = sBody & " "& VbCrLf
sBody = sBody & " "& VbCrLf
sBody = sBody & "Данное письмо составлено автоматически, отвечать на него не нужно." & VbCrLF
sBody = sBody & "Если у вас возникли какие-либо вопросы по обмену, то, пожалуйста, свяжитесь со службой технической поддержки 1С."
Const cdoSendUsingPickup = 1 'Отправить письмо с использованием локального smtp сервера
Const cdoSendUsingPort = 2 'Отправить письмо через сервер smtp в сети
Const cdoAnonymous = 0 'Без аутентификации
Const cdoBasic = 1 'Базовая аутентификация (открытым тесктом)
Const cdoNTLM = 2 'NTLM
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Обмен УАТ - УПП"
objMessage.From = """1С"" <1c@ololo.ru>"
objMessage.To = strEmailAdress
For Each oFiles in oFolder.files
objMessage.AddAttachment PATH & oFiles.name
Next
objMessage.Textbody = sBody
'==Здесь прописываем конфигурационные параметры для связи с smtp сервером
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Имя или IP адрес smtp сервера
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.ololo.ru"
'Вид аутентификации, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
'Имя пользователя на smtp сервере
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "1c@ololo.ru"
'Пароль
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "ПАРОЛЬ"
'Порт сервера (обычно 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Использовать SSL для подключения (False или True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'Таймаут соединения в секундах (максимальное время пока CDO будет пытаться соедениться с smtp сервером)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 120
objMessage.Configuration.Fields.Update
'==Тут параметры заканчиваются
objMessage.Send
'перемещаем найденный ранее файл в ранее заданную папку для дальнейшего хранения
For Each oFiles in oFolder.files
fso.CopyFile PATH+oFiles.name, DEST, True
Next
'удаляем файлы из старого места
For Each oFiles in oFolder.files
fso.DeleteFile PATH+oFiles.name, True
Next
End sub
'определяем действия при нажатии кнопок yes и no, а также при простое
Select Case intButton
' Если жмакнули yes
case 6
Call Procedure1
'если жмакунли no
case 7
wscript.quit
End Select
|
Всего записей: 1655 | Зарегистр. 17-02-2006 | Отправлено: 12:38 03-06-2011 | Исправлено: kazavo4ka, 12:51 03-06-2011 |
|
