如何在Outlook中监控多个邮箱的已发送邮件文件夹？

The issue with your current code is that you're only attaching the ItemAdd event to a single Items collection (for folder A). To monitor three folders, you need to set up event handlers for each folder's Items collection. Below are two approaches to solve this—one scalable using a class module, and a simpler approach for a fixed number of folders.

Recommended Approach: Class Module (Scalable) #

This method is cleaner and easier to maintain if you ever need to add more folders later.

Step 1: Create a Class Module #

1. Open the VBA Editor (Alt + F11).
2. Right-click your project in the Project Explorer > Insert > Class Module.
3. Rename the class module to clsSentItemsMonitor (use the Properties Window F4 to change the name).
4. Paste this code into the class module:

Public WithEvents SentItems As Outlook.Items

Private Sub SentItems_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        ' Your existing processing logic goes here
        ' Example:
        Debug.Print "New sent item: " & Item.Subject & " (from " & Item.SendUsingAccount & ")"
    End If
End Sub

Step 2: Update ThisOutlookSession #

In the ThisOutlookSession module, declare module-level instances of the class and initialize them in Application_Startup:

' Declare monitor instances at the module level (outside any sub)
Private MonitorA As clsSentItemsMonitor
Private MonitorB As clsSentItemsMonitor
Private MonitorC As clsSentItemsMonitor

Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim AFolder As Outlook.MAPIFolder
    Dim BFolder As Outlook.MAPIFolder
    Dim CFolder As Outlook.MAPIFolder
    
    Set olNs = Application.GetNamespace("MAPI")
    
    ' Fix the typo in your original folder path (missing backslash)
    Set AFolder = GetFolder("a@email.co.uk\Inbox\Sent Items")
    Set BFolder = GetFolder("b@email.com\Inbox\Sent Items")
    Set CFolder = GetFolder("c@email.com\Inbox\Sent Items")
    
    ' Initialize each monitor and link to the folder's Items collection
    Set MonitorA = New clsSentItemsMonitor
    Set MonitorA.SentItems = AFolder.Items
    
    Set MonitorB = New clsSentItemsMonitor
    Set MonitorB.SentItems = BFolder.Items
    
    Set MonitorC = New clsSentItemsMonitor
    Set MonitorC.SentItems = CFolder.Items
End Sub

Alternative Approach: Separate Event Handlers (No Class Module) #

If you prefer not to use a class module, you can declare separate Items variables and event subs for each folder:

' Declare module-level Items variables
Private AItems As Outlook.Items
Private BItems As Outlook.Items
Private CItems As Outlook.Items

Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Dim AFolder As Outlook.MAPIFolder
    Dim BFolder As Outlook.MAPIFolder
    Dim CFolder As Outlook.MAPIFolder
    
    Set olNs = Application.GetNamespace("MAPI")
    
    ' Fix the typo in the first folder path
    Set AFolder = GetFolder("a@email.co.uk\Inbox\Sent Items")
    Set BFolder = GetFolder("b@email.com\Inbox\Sent Items")
    Set CFolder = GetFolder("c@email.com\Inbox\Sent Items")
    
    ' Assign each folder's Items collection to the module variables
    Set AItems = AFolder.Items
    Set BItems = BFolder.Items
    Set CItems = CFolder.Items
End Sub

' Event handlers for each folder
Private Sub AItems_ItemAdd(ByVal Item As Object)
    ProcessSentItem Item
End Sub

Private Sub BItems_ItemAdd(ByVal Item As Object)
    ProcessSentItem Item
End Sub

Private Sub CItems_ItemAdd(ByVal Item As Object)
    ProcessSentItem Item
End Sub

' Helper sub to reuse your processing logic
Private Sub ProcessSentItem(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        ' Your existing processing code here
        Debug.Print "Processed sent item: " & Item.Subject
    End If
End Sub

Important Notes #

• Fix the Folder Path Typo: Your original code had a missing backslash in the first folder path (a@email.co.ukInbox\Sent Items → a@email.co.uk\Inbox\Sent Items). This was likely causing issues with accessing the first folder.
• Restart Outlook: Changes to Application_Startup require restarting Outlook to take effect.
• Verify GetFolder Function: Ensure your GetFolder function correctly retrieves the folders. If you run into issues, try accessing folders directly using the namespace, e.g.:

  Set AFolder = olNs.Folders("a@email.co.uk").Folders("Sent Items")
  

内容的提问来源于stack exchange，提问作者Darren_B