How to implement ItemChange for many Outlook subfolders?

问题

In a VBA module in Outlook I have currently code like this:

Private WithEvents AAInboxItems As Outlook.Items
Private WithEvents AASentItems As Outlook.Items
Private WithEvents AADoneItems As Outlook.Items

Private Sub AAInboxItems_ItemChange(ByVal Item As Object)
    'Do Something
End Sub
Private Sub AASentItems_ItemChange(ByVal Item As Object)
    'Do Something
End Sub
Private Sub AADoneItems_ItemChange(ByVal Item As Object)
    'Do Something
End Sub

Above is not the complete code, just to show the principle. This works fine for a couple of folders for which I implemented this.

I would like to have such events for all subfolders of the Inbox. And this should work dynamically. If the user creates a new sub-folder then I don't want to change the code. I want to have an event which fires when an item is changed in any Outlook Inbox subfolder.

Is that possible? How?

Edit: With Dmitry Streblechenko's answer I tried the following but it does not do what I want it to do - maybe I implemented it incorrectly. The events fire but only for the last assigned folder and not all folders. This is what I expected but maybe I made something wrong or didn't understand the answer correct. I put this information in the question because it won't fit in a comment to Dmitry's answer.

The following are the most important parts of the code. I leave lots of details out to make it shorter. Basically it works, but only for one folder.

Option Explicit
Global gbl_FolderItems(3) As Outlook.Items
Private WithEvents FolderItems As Outlook.Items

Private Sub Application_Startup()
    For intI = 1 To 3
        'This works only with the last folder
        'Set gbl_FolderItems(intI) = objGetFolderItems("Folder" & intI)
        'Set FolderItems = gbl_FolderItems(intI)

        'This works only with the last folder
        Set FolderItems = objGetFolderItems("Folder" & intI)
        Set gbl_FolderItems(intI) = FolderItems
    Next
End Sub

Private Function objGetFolderItems(strFolderShortName As String) As Outlook.Items
    Dim olApp As Outlook.Application
    Set olApp = Outlook.Application
    Dim objNS As Outlook.NameSpace
    Set objNS = olApp.GetNamespace("MAPI")
    Dim obj As Outlook.Items

    Select Case strFolderShortName
    Case "Folder1"
        Set obj = objNS.Folders("MyAccount").Folders("Inbox").Folders("Folder1").Items
    Case "Folder2"
        Set obj = objNS.Folders("MyAccount").Folders("Inbox").Folders("Folder2").Items
    Case "Folder3"
        Set obj = objNS.Folders("MyAccount").Folders("Inbox").Folders("Folder1").Folders("Folder3").Items
    End Select
    Set objGetFolderItems = obj
End Function

Private Sub FolderItems_ItemChange(ByVal Item As Object)
    Debug.Print "FolderItems_ItemChange(" & Item.Subject & ")"
End Sub

Private Sub FolderItems_ItemAdd(ByVal Item As Object)
    Debug.Print "FolderItems_ItemAdd(" & Item.Subject & ")"
End Sub

回答1:

You may consider creating a COM add-in instead. In that case you will be able to subscribe to folder events dynamically. See Walkthrough: Creating Your First VSTO Add-In for Outlook for more information.

Also you may consider using a low-level API - Extended MAPI. See MAPI Notification Events for more information. Or just use any third-party wrappers around that API such as Redemption.

回答2:

Declare a single WithEvents Items variable, loop through the folders that you want to track, assign the Items variable, and store it in a global array. Even though the variable will be overwritten on each iteration, all of the folders will be monitored because all the different Items objects are still alive and raising events since they are referenced by the array.

来源：https://stackoverflow.com/questions/50034435/how-to-implement-itemchange-for-many-outlook-subfolders