Войти

Показать полную графическую версию : Помогите доработать скрипт отправки по почте с аттачем


diavard
19-02-2011, 22:23
Добрый день. Помогите решить проблему.

Есть полностью рабочий скрипт gmail.vbs
Действия скрипта:
проверяет соединение с интернетом, если нет соединения - выдает
сообщение: "Проверьте соединение с интернетом".
Если интернет есть -
Создает письмо с указанными в скрипте параметрами и прикрепляет файл,
лежащий по пути: D:\Program files\Blablabla\zakaz\zacaz035_2.rpt
Отправляет этот файл по почте и выводит сообщение клиенту: "Ваш заказ успешно отправлен!"

Не могу решить:
1. Программа Blablabla не всегда находится по пути D:\Program files\Blablabla, у разных пользователей пути разные.
Как заставить скрипт искать где установлена программа?? Запись о пути установки есть в реестре:
HKEY_LOCAL_MACHINE\SOFTWARE\Blablabla
(параметр Path).
2. Как заставить прикреплять не конкретый файл, а файл с раширением
*.rpt, так как все имена заказов разные.


set WshShell = CreateObject("WScript.Shell")
'Запускаем ping и ожидаем завершения его работы
Return = WshShell.Run("ping www.google.com ", 0, true)
If Return=1 then
MsgBox"Проверьте соединение с интернетом!"
Else

Const cdoSendUsingPickup = 1 'Send message using the local SMTP service pickup directory.
Const cdoSendUsingPort = 2 'Send the message using the network (SMTP over the network).

Const cdoAnonymous = 0 'Do not authenticate
Const cdoBasic = 1 'basic (clear-text) authentication
Const cdoNTLM = 2 'NTLM

Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Тема"
objMessage.From = """Zakaz"" <user@gmail.com>"
objMessage.To = "mybox@gmail.com"
objMessage.TextBody = "Вам был отправлен заказ."
objMessage.AddAttachment " D:\Program files\Blablabla\zakaz\zacaz035_2.rpt "

'==This section provides the configuration information for the remote SMTP server.

objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"

'Type of authentication, NONE, Basic (Base64 encoded), NTLM
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic

'Your UserID on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "user@gmail.com"

'Your password on the SMTP server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"

'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

'Use SSL for the connection (False or True)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

objMessage.Configuration.Fields.Update

'==End remote SMTP server configuration section==

objMessage.Send

MsgBox"Ваш заказ успешно отправлен!"
End if

SendMessage
20-02-2011, 04:45
Вставьте эту функцию в скрипт:
Function GetAttach
Dim strPath
Dim arrFiles
strPath = WshShell.RegRead("HKLM\SOFTWARE\Blablabla\Path") & "\zakaz\"
Set arrFiles = CreateObject("Shell.Application").NameSpace(strPath).Items
arrFiles.Filter 64, "zacaz*.rpt"
Select Case arrFiles.Count
Case 0
MsgBox "Файл для отправки не найден.", 48, "Отправка файла"
WScript.Quit 1
Case 1
GetAttach = arrFiles.Item(0).Path
Case Else
MsgBox "Найдено несколько файлов.", 48, "Отправка файла"
WScript.Quit 1
End Select
End Function
И поменяйте строку objMessage.AddAttachment " D:\Program files\Blablabla\zakaz\zacaz035_2.rpt " на objMessage.AddAttachment GetAttach

Iska
20-02-2011, 05:50
SendMessage, уточнение:objMessage.AddAttachment " D:\Program files\Blablabla\zakaz\zacaz035_2.rpt "

по:
strPath = WshShell.RegRead("HKLM\SOFTWARE\Blablabla\Path") & "\zacaz\"
Вообще мудрёно у автора: раз так названо, раз этак ;).

diavard
21-02-2011, 13:56
SendMessage, спасибо большое, все работает отлично. Упустил еще один момент - после того, как файл с заказом отправлен - он остается в папке zakaz. Помогите пожалуйста, чтоб после отправки письма с вложением этот заказ перемещаляся в папку old_zakaz. Не копировался, а именно перемещался. Заранее спасибо.

Iska, Папка, где хранится файл заказ называется zakaz, а вот сам файл - zacaz.
Мудрено, потому что структуру инсталлятора писал я, а функцию вывода файла с заказом - другой человек. Вот и получилось. :unsure:

SendMessage
21-02-2011, 14:55
Вместо строки
objMessage.AddAttachment GetAttach
вставьте эти:
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
OutFolder = "D:\Program files\Blablabla\old_zakaz\"
AttachFile = GetAttach
OutAttachFile = OutFolder & fso.GetFileName(AttachFile)
objMessage.AddAttachment AttachFile
If fso.FileExists(OutAttachFile) Then fso.DeleteFile OutAttachFile
fso.MoveFile AttachFile, OutFolder
Не проверял.




© OSzone.net 2001-2012