Обработка отмены COM-события в VBScript

Question

Я хотел бы написать сценарий, который отправляет электронную почту через SMTP-сервер нашей компании с использованием CDO.

Сначала я попытался написать HTA-приложение для этой цели, но стало довольно неудобно делать его достаточно комфортным, чтобы другие люди могли справиться с ним (из-за правильного разрешения получателей).

Итак, теперь я пытаюсь использовать обычную маску Outlook-Mail, чтобы сначала подготовить почту, а затем перехватить событие send-item через VBScript, чтобы передать его содержимое моему сценарию CDO.

Прямо сейчас мой код выглядит так:

Dim OutlookApplication
Dim MailItem
Const olDiscard = 1
Const olMailItem = 0

Set OutlookApplication = WScript.CreateObject("Outlook.Application", "Outlook_")
Set MailItem = OutlookApplication.CreateItem(olMailItem)
MailItem.Display

'(...) some code to add recipients, subject, text, etc... depending on the given WScript.Arguments

While Not MailItem Is Nothing
    'keep the script alive
    WScript.Sleep 1
WEnd

Function CDOSendMessage()
    'some code to send the data to our smtp server, return true if successfull
    CDOSendMessage = True
End Function

Sub Outlook_ItemSend(byVal Item, Cancel)
    If Item.body = MailItem.body Then 'Any more fail proof suggestions on how to check if it's the correct mailitem I'm handling with this event? While the script is alive, it fires for EVERY mail I send via outlook
        Cancel = True

        If CDOSendMessage() then
            Set MailItem = Nothing
            MailItem.Close olDiscard
        Else
            Cancel = False
            MsgBox "Sending message via CDO failed."
        End If
    End If
End Sub

Основная проблема в том, что Cancel = True просто не работает. Outlook отправит мою почту, используя мой обычный почтовый адрес, несмотря ни на что. Подскажите, пожалуйста, что я делаю не так?

Заранее большое спасибо!

Guido

Answer 1

Параметр Cancel должен быть объявлен с ByRef модификатор.

Answer 2

Обновленный код по запросу: Dim OutlookApplication Dim MailItem Dim CDODone: CDODone = False Const olDiscard = 1 Const olMailItem = 0

Set OutlookApplication = WScript.CreateObject("Outlook.Application", "Outlook_")
Set MailItem = OutlookApplication.CreateItem(olMailItem)
MailItem.UserProperties.Add "CDOFlag", 20, false, false
MailItem.Display

'(...) some code to add recipients, subject, text, etc... depending on the given WScript.Arguments

While Not CDODone Is Nothing
    'keep the script alive
    WScript.Sleep 1
WEnd
MailItem.Close olDiscard
Function CDOSendMessage()
    'some code to send the data to our smtp server, return true if successfull
    CDOSendMessage = True
End Function

Sub Outlook_ItemSend(byVal Item, byRef Cancel)
    If Not Item.UserProperties.Find(CDOFlag) Is Nothing Then
        Cancel = True

        If CDOSendMessage() then
            CDODOne = True
        Else
            Cancel = False
            MsgBox "Sending message via CDO failed."
            WScript.Quit
        End If
    End If
End Sub