Автоматическая отправка почты в контексте Outlook.

Нашел элегантное решение отправки сообщения в контексте профиля 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 = "<H3><B>Dear Customer</B></H3>" & _

              "Please visit this website to download the new version.<br>" & _

              "Let me know if you have problems.<br>" & _

              "<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _

              "<br><br><B>Thank you</B>"



    '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 & "<br><br>" & 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