在 VBScript 中处理 COM 事件取消



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

首先,我试图为此目的编写一个HTA应用程序,但是为了使它足够舒适,以便其他人可以很好地处理它(因为正确的收件人解析),它变得相当繁琐。

因此,现在我尝试使用常规的Outlook-Mail掩码首先准备邮件,然后通过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

主要问题是,取消 = 真根本不起作用。无论如何,Outlook 都会使用我的常规邮件地址发送我的邮件。你能告诉我,我做错了什么吗?

提前非常感谢!

圭多

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

根据要求更新了代码: 昏暗的前景应用程序 暗淡邮件项目 调暗的 CDODone:CDODone = 假 常量奥尔丢弃 = 1 常量 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

最新更新