当新电子邮件到达共享邮箱中的任何子文件夹时运行代码

我想在任何新电子邮件到达特定共享邮箱时运行代码。

当电子邮件到达 INBOX 文件夹时触发该事件。
如果新电子邮件直接进入其子文件夹，则该事件不会触发 - 例如[电子邮件受保护]/收件箱/子文件夹1。

如果收件箱中的任何子文件夹收到新电子邮件，我应该更改什么才能运行代码？

邮箱有很多子文件夹。此外，它们的结构可能会改变。

Option Explicit
Private WithEvents mtFolder As Outlook.Folder 
Private WithEvents mtItems As Outlook.Items
  

Private Sub mtItems_ItemAdd(ByVal Item As Object)
  Debug.Print "XXX" 
  'my CODE
End Sub


Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Dim objOwner
    Set objOwner = Ns.CreateRecipient("[email protected]")
    objOwner.Resolve
    If objOwner.Resolved Then
        Set mtFolder = Ns.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set mtItems = mtFolder.Items
    End If
  
    Set Ns = Nothing
    Exit Sub
eh:
End Sub

非常感谢您的帮助！这是解决方案。 首先，我添加了名为“clsFolder”的类模块和事件：

Option Explicit

Private OlFldr As Folder
Public WithEvents Items As Outlook.Items

'called to set up the object
Public Sub Init(f As Folder) ', sPath As String)
    Set OlFldr = f
    Set Items = f.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
       Debug.Print "eMail '" & Item.Subject & "' was added to Folder '" & OlFldr.name & _
              "'. Mailbox: '" & Item.Parent.Store & "'."
       'do sth with a email added...
  End If
End Sub

然后在 ThisOutlookSession 中，我设置了所有文件夹的集合（共享邮箱中的子文件夹：

Option Explicit
Public colFolders As Collection  '<< holds the clsFolder objects with events

Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Dim oFolder As Outlook.Folder
    Set Ns = Application.GetNamespace("MAPI")
    Dim objOwner
    Set objOwner = Ns.CreateRecipient("my_Shared_Mailibox")
    objOwner.Resolve
    If objOwner.Resolved Then
        Set oFolder = Ns.GetSharedDefaultFolder(objOwner, olFolderInbox) 
        Set colFolders = New Collection
        processFolder oFolder
    End If
    Set Ns = Nothing
    Set oFolder = Nothing
    Exit Sub
eh:
    
End Sub


'function to create folder objects
Function GetFolderObject(foldr As Folder)
    Dim rv As New clsFolder
    rv.Init foldr
    Set GetFolderObject = rv
End Function

'process all subfolders
Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)
        Dim oFolder As Outlook.MAPIFolder
        colFolders.Add GetFolderObject(oParent)
        
        Dim oMail As Outlook.MailItem
        For Each oMail In oParent.Items
               'do sth with every email if necessary 
        Next
        If (oParent.Folders.Count > 0) Then
            For Each oFolder In oParent.Folders
                processFolder oFolder
            Next
        End If
End Sub