How to implement ItemChange for many Outlook subfolders? - vba

Question

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

Answer 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.

Answer 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.

Answer 3

There is a solution, it's pure VBA, however it's not so straightforward:
create a HandlerClass with singular event NewItem and one public method to raise it from outside of the class:
Public Event NewItem(ByVal Item As Object)
Public Sub raise(ByVal Item As Object)
RaiseEvent NewItem(Item)
End Sub
create a FolderWatcherClass holding singular folder and handling its Items' ItemAdd event:
Private folder As Outlook.MAPIFolder
Private WithEvents fItems As Outlook.Items
Private handler As CLAhandler
Public Sub init(f As Outlook.MAPIFolder, h As CLAhandler)
Set folder = f
Set fItems = f.Items
Set handler = h
End Sub
Private Sub fItems_ItemAdd(ByVal Item As Object)
Call handler.raise(Item)
End Sub
You have the two classes defined now, so declare the handler and array of watchers in the module:
Private WithEvents commonEventHandler As HandlerClass
Private folderWatchers() As FolderWatcherClass
then initialize them
Private Sub Application_Startup()
' create new WithEvents handler object, common to all folderWatchers
Set commonEventHandler = New HandlerClass
' hook folder handlers
' start with the Inbox, then traverse recursively all the subfolders
Call ProcessFolder(Outlook.Application.Session.GetDefaultFolder(olFolderInbox))
End Sub
Private Sub ProcessFolder(ByVal thisFolder As Outlook.MAPIFolder)
Dim subFolder As Outlook.MAPIFolder
Dim u As Long
' tricky check if the folderWatchers array has been initialized - assuming its UBound 'sbeen not initialized to -1 :)
u = -1
On Error Resume Next
u = UBound(folderWatchers)
On Error GoTo 0
' redim the array
If u = -1 Then
' the first folder, presumably the Inbox itself
ReDim folderWatchers(1 To 1)
Else
' all the subsequent subfolders
ReDim Preserve folderWatchers(1 To UBound(folderList) + 1)
End If
' store a new instance of folder watcher in the array
Set folderWatchers(UBound(folderWatchers)) = New FolderWatcherClass
' initialize it (WithEvents in the FolderWatcherClass!) with the thisFolder and the common event handler
Call folderWatchers(UBound(folderWatchers)).init(thisFolder, commonEventHandler) ' pass THE SAME common event handler to each of the watchers!
' process the subfolders in the current folder recursively
If (thisFolder.Folders.Count > 0) Then
For Each subFolder In thisFolder.Folders
If subFolder.DefaultItemType = olMailItem Then Call ProcessFolder(subFolder) ' process only the folders containing mail items
Next
End If
' you can refine the criteria above to watch only specified folders if needed
End Sub
Now it's the only one thing left to make it work, we have to handle the common event:
Private Sub commonEventHandler_NewItem(ByVal Item As Object)
' do whatever you like here
End Sub
Summarizing:
The HandlerClass provides singular event handler for all the folders
The FolderWatcherClass array holds each of the folders redirecting their ItemAdd events to the common HandlerClass object
Disclaimer: I renamed variables, methods and objects used in my original code to make them more understandable - I hope I've done it consequently and the code is consistent :)