Question

我想编写一个脚本，使用CDO通过我们公司的SMTP服务器发送电子邮件。

首先，我试图为此目的编写一个HTA应用程序，但是它变得很讨人喜欢，以使其足够舒适，以便其他人可以很好地处理它（由于正确的收件人解析）。

因此，现在我尝试使用常规的Outlook-Mail掩码先准备邮件，然后通过VBScript捕获send-item事件，以将其内容提供给我的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

必须使用ByRef修饰符声明Cancel参数。

Answer 2

根据要求更新代码：昏暗的OutlookApplication 昏暗邮件昏暗的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

在VBScript中处理COM事件取消

2 个答案: