Как реализовать ItemChange для многих вложенных папок Outlook?

Question

В модуле VBA в Outlook у меня в настоящее время есть код, подобный этому:

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

Выше приведен не полный код, просто чтобы показать принцип.Это прекрасно работает для пары папок, для которых я это реализовал.

Я хотел бы иметь такие события для всех подпапок папки «Входящие».И это должно работать динамически.Если пользователь создает новую подпапку, я не хочу менять код. Я хочу, чтобы событие происходило при изменении элемента в любой подпапке Outlook Inbox.

Возможно ли это?Как?

Редактировать: С ответом Дмитрия Стребленченко я попробовал следующее, но он не выполняет то, что я хочу, - возможно, я его неправильно реализовал.События запускаются, но только для последней назначенной папки, а не для всех папок.Это то, что я ожидал, но, возможно, я сделал что-то не так или не понял правильный ответ.Я включил эту информацию в вопрос, потому что она не подходит для комментария к ответу Дмитрия.

Ниже приведены наиболее важные части кода.Я оставляю много деталей, чтобы сделать их корочеВ основном это работает, но только для одной папки.

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

Answer 1

Объявите одну переменную WithEvents Items, выполните цикл по папкам, которые вы хотите отслеживать, назначьте переменную Items и сохраните ее в глобальном массиве.Несмотря на то, что переменная будет перезаписываться на каждой итерации, все папки будут отслеживаться, поскольку все различные объекты Items все еще живы и вызывают события, так как на них ссылается массив.

Answer 2

Вместо этого вы можете создать надстройку COM.В этом случае вы сможете динамически подписываться на события папки.См. Пошаговое руководство. Создание первой надстройки VSTO для Outlook для получения дополнительной информации.

Также вы можете рассмотреть возможность использования низкоуровневого API - Extended MAPI.См. События уведомления MAPI для получения дополнительной информации.Или просто используйте сторонние обертки вокруг этого API, такие как Redemption.