Помогите доработать скрипт отправки по почте с аттачем

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)

Помогите доработать скрипт отправки по почте с аттачем

Добрый день. Помогите решить проблему.

Есть полностью рабочий скрипт 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

Вставьте эту функцию в скрипт:

Код:

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

SendMessage, уточнение:

Цитата:

Цитата diavard

objMessage.AddAttachment " D:\Program files\Blablabla\zakaz\zacaz035_2.rpt "

по:

Цитата:

Цитата SendMessage

strPath = WshShell.RegRead("HKLM\SOFTWARE\Blablabla\Path") & "\zacaz\"

Вообще мудрёно у автора: раз так названо, раз этак ;).

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

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

Вместо строки

Код:

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

Не проверял.