Run code when new email comes to any subfolder in a Shared Mailbox

Question

I want to run code when any new email comes to a specific shared mailbox.

The event triggers when the email comes to INBOX folder.
The event does not trigger if a new email comes straight to its subfolders - like to shared@mailbox.com/Inbox/subfolder1.

What should I change so the code runs if a new email comes to any subfolder in the inbox?

The mailbox has a lot of subfolders. Moreover their structure may change.

Option Explicit
Private WithEvents mtFolder As Outlook.Folder 
Private WithEvents mtItems As Outlook.Items
  

Private Sub mtItems_ItemAdd(ByVal Item As Object)
  Debug.Print "XXX" 
  'my CODE
End Sub


Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Dim objOwner
    Set objOwner = Ns.CreateRecipient("shared@mailbox.com")
    objOwner.Resolve
    If objOwner.Resolved Then
        Set mtFolder = Ns.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set mtItems = mtFolder.Items
    End If
  
    Set Ns = Nothing
    Exit Sub
eh:
End Sub

[Loop to set up watches on a selection of Outlook folders](https://stackoverflow.com/questions/42257360) demonstrates how to apply a single instance of ItemAdd code on multiple folders. [Can I iterate through all Outlook emails in a folder including sub-folders?](https://stackoverflow.com/questions/2272361) demonstrates how you might get the folders. If you succeed, post an answer. If not successful, since you are new, do not ask for clarification in an answer to these posts, edit this question with your code. — niton, Sep 30 '22 at 00:28

Miro · Accepted Answer · 2022-10-11T12:58:54.107

Thank you a lot for your help! Here the solution. At first I have added Class Module named "clsFolder" with events:

Option Explicit

Private OlFldr As Folder
Public WithEvents Items As Outlook.Items

'called to set up the object
Public Sub Init(f As Folder) ', sPath As String)
    Set OlFldr = f
    Set Items = f.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
  If TypeOf Item Is Outlook.MailItem Then
       Debug.Print "eMail '" & Item.Subject & "' was added to Folder '" & OlFldr.name & _
              "'. Mailbox: '" & Item.Parent.Store & "'."
       'do sth with a email added...
  End If
End Sub

Then in ThisOutlookSession I setup a collecion of folder for all (sub)folders in the SharedMailbox:

Option Explicit
Public colFolders As Collection  '<< holds the clsFolder objects with events

Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Dim oFolder As Outlook.Folder
    Set Ns = Application.GetNamespace("MAPI")
    Dim objOwner
    Set objOwner = Ns.CreateRecipient("my_Shared_Mailibox")
    objOwner.Resolve
    If objOwner.Resolved Then
        Set oFolder = Ns.GetSharedDefaultFolder(objOwner, olFolderInbox) 
        Set colFolders = New Collection
        processFolder oFolder
    End If
    Set Ns = Nothing
    Set oFolder = Nothing
    Exit Sub
eh:
    
End Sub


'function to create folder objects
Function GetFolderObject(foldr As Folder)
    Dim rv As New clsFolder
    rv.Init foldr
    Set GetFolderObject = rv
End Function

'process all subfolders
Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)
        Dim oFolder As Outlook.MAPIFolder
        colFolders.Add GetFolderObject(oParent)
        
        Dim oMail As Outlook.MailItem
        For Each oMail In oParent.Items
               'do sth with every email if necessary 
        Next
        If (oParent.Folders.Count > 0) Then
            For Each oFolder In oParent.Folders
                processFolder oFolder
            Next
        End If
End Sub

Run code when new email comes to any subfolder in a Shared Mailbox

1 Answers1

Linked