ItemAdd and FolderAdd events problem with Public Folders

[Kebook]

Hello all,

I have something like 1.700 Public Folders, each containing dozens of items (mails, posts, documents).

I want to implement a tool that will inform each user if there is a new item added to any Public Folder. Easiest way is to mark all new items as unread and then iterate through folders to get a list. Furthermore the tool should mark as new only the items placed by other users and don't notify about "own" new items.

I have a solution working on Outlook 2003. There is a wrapper class for Folder objects and global collection of these objects. It catches ItemAdd events for new items and FolderAdd events for new Folders added to collection (so the folder is automatically added to the global collection).

But I can't make it work under Outlook 2010. It doesn't work neither as VBA macro nor as COM addin. My programs collects all folders, fires proper events but somewhere is a memory leak (??) which causes I can’t use Outlook – can’t open folders (InBox, OutBox, etc) or items displaying out of memory error.

Can You help me figure it out what am I doing wrong? Below You will find the source codes.

Thanks in advance for Your help.

Chris

1. Wrapper class for Foder_Items to catch ItemAdd event:

' Wrapper class for PublicFolders and Items in each PublicFolder
' All Instances are kept in Global Collection
' Event ItemAdd is fired if any change to Folder.Items occurs
' Event FolderAdd is fired if any change to Folder.Folders occurs
Private WithEvents mItems As Outlook.Items
Private WithEvents mFolders As Outlook.Folders
Public Property Let WatchedItems(SetItems As Outlook.Items)
  On Error Resume Next
  Set mItems = SetItems
End Property
Public Property Get WatchedItems() As Outlook.Items
  On Error Resume Next
  Set WatchedItems = mItems
End Property
Public Property Let WatchedFolder(SetFolder As Outlook.MAPIFolder)
  On Error Resume Next
  Set mFolders = SetFolder.Folders
End Property
Public Property Get WatchedFolder() As Outlook.MAPIFolder
  On Error Resume Next
  Set WatchedFolder = mFolders.Parent
End Property
Private Sub Class_Initialize()
  On Error Resume Next
  Set mItems = Nothing
  Set mFolders = Nothing
End Sub
Private Sub Class_Terminate()
  On Error Resume Next
  Set mItems = Nothing
  Set mFolders = Nothing
End Sub
Private Sub mItems_ItemAdd(ByVal Item As Object)
  On Error Resume Next
  Debug.Print "New item: " & Item.Subject
End Sub
Private Sub mFolders_FolderAdd(ByVal Folder As Outlook.MAPIFolder)
  On Error Resume Next
  Debug.Print "New folder: " & Folder.Name
End Sub

2. Code for iterating folders and creating global collection of wrapper class objects:

Public mWatcherCol As New Collection
Public Sub Watcher_ClearCollections()
  On Error Resume Next
  For i = 1 To mWatcherCol.count
  mWatcherCol.Remove 1
  Next i
End Sub
Public Sub Watcher_TestCollection()
  MsgBox "mWatcherCol_Count:" & mWatcherCol.count
End Sub
' Main Function to start iterating all Public Folders
Public Sub Watcher_Start()
  Call Watcher_ClearCollections
  ‘ function FoldersCollection.GetFolder(FolderPath) is defined somewhere else
  ‘ it works good, returns a MAPIFolder object
  Call  Watcher_IterateFolders(FoldersColection.GetFolder("\\C2PublicFolders"))
End Sub
Public Function Watcher_IterateFolders(startFolder As Outlook.MAPIFolder)
  Dim watch As New WatcherClass
  watch.WatchedItems = startFolder.Items
  watch.WatchedFolder = startFolder
  mWatcherCol.Add watch
  Set watch = Nothing
  Dim mFolder As Outlook.MAPIFolder
  For Each mFolder In startFolder.Folders
  Call Watcher_IterateFolders(mFolder)
  Next
  Set mFolder = Nothing
End Function