VBS/WSH/JS - Автоматическая отправка почты в контексте Outlook.

[MioZo]

Нашел элегантное решение отправки сообщения в контексте профиля Outlook. По определенным причинам применение сторонних утилит и работа напрямую с почтовым сервером недопустима.

1. В Outlook 2007/2010 создаем макрос с текстом (авторство не моё):



Код:

Код: Выделить всё

Function GetAttach()
  Dim strPath
  Dim arrFiles
    strPath = "C:\test"
    Set arrFiles = CreateObject("Shell.Application").NameSpace(strPath).Items
    arrFiles.Filter 64, "*.txt"
    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
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
   Dim fso As Object
    Dim ts As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
  Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
  GetBoiler = ts.readall
  ts.Close
End Function
Sub Mail_Outlook_With_Signature_Html()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String
    Set OutApp = CreateObject("Outlook.Application")
   If TypeName(Application.ActiveWindow) = "Inspector" Then
    Application.ActiveWindow.WindowState = 1
End If
    Set OutMail = OutApp.CreateItem(0)
    strbody = "Dear Customer" & _
              "Please visit this website to download the new version.
" & _
              "Let me know if you have problems.
" & _
              "Ron's Excel Page" & _
              "

Thank you"
    'Use the second SigString if you use Vista or win 7 as operating system
    SigString = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\Valeev.htm"
    If Dir(SigString)  "" Then
    Signature = GetBoiler(SigString)
        'Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = strbody & "

" & Signature
        'You can add files also like this
        .Attachments.Add GetAttach
        .Send   'or use .Display
    End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

2. Сохраняем макрос.

3. Создаем командный файл с текстом "C:\Program Files\Microsoft Office\Office14\OUTLOOK.EXE" /autorun Mail_Outlook_With_Signature_Html

4. Создаем задачу с расписанием.

5. В результате никогда не забудем отправить суточный отчет ).

---

Хорошие ссылки:

http://msdn.microsoft.com/ru-ru/libr...m_members.aspx

http://office.microsoft.com/ru-ru/ou...001003110.aspx

[MioZo]

1. Вопрос, вот только почему-то подпись в Outlook 2010 не "цепляется". Понять упорно не могу.

2. Если файлов более одного, отправка не выполняется. Как это решить?



Спасибо всем большое.