移动到子文件夹的项目的传入消息侦听器

Question

下面是包含我尝试过的几个解决方案的代码。
第一个是设置第二个 items_by_add 函数，并将其从我的第二个收件箱“Data”中抓取项目更改为该收件箱“adam”的子文件夹。
然后我尝试利用 beforeItemMove 函数。

通过这两种尝试，这些函数都不会被调用，但它们会编译。

我无法更改此收件箱的规则。

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olApp As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim Inbox As Outlook.Folder
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    'Set SubFolder = Application.Session.GetDefaultFolder(olFolderInbox)
    'Set Inbox = objNS.Folders("my email").Folders("People").Folders("adam")
    Set Items = objNS.Folders.Item("Data").Folders.Item("Inbox").Items
    'Set Items1 = objNS.Folders.Item("my email").Folders.Item("Inbox").Item.BeforeItemMove(Outlook.MailItem, "adam", False)
    Set Items1 = objNS.Folders.BeforeItemM("my email").Folders.item("people").Folders.item("adam")
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    Dim Msg As Outlook.MailItem
    If TypeOf Item Is Outlook.MailItem Then
        'save attachment
    End If
End Sub
    
Private Sub Items1_ItemAdd(ByVal Item As Object)
    Dim Msg As Outlook.MailItem
    If TypeOf Item Is Outlook.MailItem Then
        'save attachment
    End If
End Sub
    
Private Sub SubFolder_BeforeItemMove(ByVal Item As Object, ByVal MoveTo As MAPIFolder, Cancel As Boolean)
    If MoveTo = Inbox Then
        MsgBox Item.Subject & " was moved to Inbox"
    End If
End Sub

Answer 1

代码中没有Items1 对象的定义。理想情况下，代码应如下所示：

Private WithEvents Items As Outlook.Items
Private WithEvents Items1 As Outlook.Items

但我建议处理Application 类的NewMailEx 事件，该事件在收件箱中收到新项目时触发。对于 Microsoft Outlook 处理的每个收到的项目，此事件都会触发一次。该项目可以是几种不同的项目类型之一，例如MailItem、MeetingItem 或SharingItem。 NewMailEx 事件在新邮件到达收件箱时以及在客户端规则处理发生之前触发。您可以使用EntryIDCollection 数组中返回的Entry ID 来调用NameSpace.GetItemFromID 方法并处理该项目。请谨慎使用此方法，以尽量减少对 Outlook 性能的影响。但是，根据客户端计算机上的设置，新邮件到达收件箱后，垃圾邮件过滤和将新邮件从收件箱移动到另一个文件夹的客户端规则等过程可能会异步发生。