Question

我有一个宏，提示您在发送之前将电子邮件保存到指定的文件夹，但我无法让宏用于接收电子邮件。

这是我发送电子邮件的原因：

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    If TypeOf Item Is Outlook.MailItem Then
      Cancel = Not SaveSentMail(Item)
    End If
End Sub

Private Function SaveSentMail(Item As Outlook.MailItem) As Boolean
    Dim F As Outlook.MAPIFolder

    If Item.DeleteAfterSubmit = False Then
        Set F = Application.Session.PickFolder
        If Not F Is Nothing Then
            Set Item.SaveSentMessageFolder = F
            SaveSentMail = True
        End If
    End If
End Function

Answer 1

使用 Application.Startup Event (Outlook) 和 Items.ItemAdd Event (Outlook)

_{Items.ItemAdd Event (Outlook) 在将一个或多个项目添加到指定集合时发生。当大量项目一次添加到文件夹时，此事件不会运行。 Microsoft Visual Basic Scripting Edition（VBScript）中不提供此事件。}

_{Application.Startup Event (Outlook) 在Microsoft Outlook启动时发生，但在加载所有加载项程序之后。}的

代码示例

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim Inbox  As Outlook.MAPIFolder

    Set olNs = Application.GetNamespace("MAPI")
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    Dim Folder As Outlook.MAPIFolder

    If TypeOf Item Is Outlook.mailitem Then
        Set Folder = Application.Session.PickFolder
        If Folder Is Nothing Then Exit Sub
        Item.Move Folder
    End If

End Sub

Answer 2

您可以处理Application类的NewMailEx事件，该事件在新邮件到达收件箱时以及客户端规则处理发生之前触发。您可以使用EntryIDCollection数组中返回的条目ID来调用NameSpace.GetItemFromID方法并处理该项。请谨慎使用此方法，以尽量减少对Outlook性能的影响。

请注意，对于具有Exchange Server帐户（非缓存Exchange模式或缓存Exchange模式）的用户，只有在Outlook启动后到达服务器的邮件才会触发该事件。在Outlook启动后立即在缓存Exchange模式下同步的邮件不会触发事件，也不会触发Outlook在非缓存Exchange模式下启动时服务器上已有的邮件。

另一种可能的选择是处理Items类的ItemAdd事件，该事件在将一个或多个项目添加到指定集合时触发。请注意，当大量项目一次添加到文件夹时，此事件不会运行（超过16个 - 这是OOM中众所周知的问题）。

更好的解决方案是使用计时器事件检查文件夹中的新项目。阅读以下文章中有关可能解决方案的更多信息：

收到新邮件后触发宏

2 个答案: