Move Shared Mailbox Email To Folder When Category Assigned

Question

I have a script that works on my main inbox. It will move the email to a sub folder when a category is assigned. The sub folder is the same name as the category.

How do I modify the code to reference a shared mailbox?

My code that works on main inbox:

Private WithEvents xInboxFld As Outlook.Folder
Private WithEvents xInboxItems As Outlook.Items
 
Private Sub Application_Startup()
    Set xInboxFld = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set xInboxItems = xInboxFld.Items
End Sub
 
Private Sub xInboxItems_ItemChange(ByVal Item As Object)
Dim xMailItem As Outlook.MailItem
Dim xFlds As Outlook.Folders
Dim xFld As Outlook.Folder
Dim xTargetFld As Outlook.Folder
Dim xFlag As Boolean
On Error Resume Next
If Item.Class = olMail Then
    Set xMailItem = Item
    xFlag = False
    If xMailItem.Categories <> "" Then
        Set xFlds = Application.Session.GetDefaultFolder(olFolderInbox).Folders
        If xFlds.Count <> 0 Then
            For Each xFld In xFlds
                If xFld.Name = xMailItem.Categories Then
                    xFlag = True
                End If
            Next
        End If
        If xFlag = False Then
            Application.Session.GetDefaultFolder(olFolderInbox).Folders.Add xMailItem.Categories, olFolderInbox
        End If
        Set xTargetFld = Application.Session.GetDefaultFolder(olFolderInbox).Folders(xMailItem.Categories)
        xMailItem.Move xTargetFld
    End If
End If
End Sub

Does this answer your question? [Get reference to additional Inbox](https://stackoverflow.com/questions/9076634/get-reference-to-additional-inbox) — niton, Sep 08 '21 at 03:03

score 2 · Answer 1 · answered Sep 08 '21 at 14:04

I was able to get it working with the below

Option Explicit

Private WithEvents SharedInboxFld As Outlook.Folder
Private WithEvents SharedInboxItems As Outlook.Items
 
Private Sub Application_Startup()
    Set SharedInboxFld = Outlook.Application.Session.Folders.Item("Shared MailboxName").Folders("Inbox")  'use the appropriate folder name
    Set SharedInboxItems = SharedInboxFld.Items
End Sub


Private Sub SharedInboxItems_ItemChange(ByVal Item As Object)
Dim xFlds As Outlook.Folders
Dim xFld As Outlook.Folder
Dim xTargetFld As Outlook.Folder
Dim xFlag As Boolean
    On Error Resume Next
    If Item.Class = olMail Then
        xFlag = False
        If Item.Categories <> "" Then
            Set xFlds = SharedInboxFld.Folders
            If xFlds.Count <> 0 Then
                For Each xFld In xFlds
                    If xFld.Name = Item.Categories Then
                        xFlag = True
                    End If
                Next
            End If
            If xFlag = False Then
                SharedInboxFld.Folders.Add Item.Categories, olFolderInbox
            End If
            Set xTargetFld = SharedInboxFld.Folders(Item.Categories)
            Item.Move xTargetFld
        End If
    End If
End Sub

Thank you for your contribution. Please consider providing a short summary as to what you fixed and why it was wrong. — Jaco-Ben Vosloo, Sep 08 '21 at 14:15
Keep in mind that will only work if the mailbox in question is open and visible in your profile. `GetSharedDefaultFolder` will work in all cases as long as you have the right permissions. — Dmitry Streblechenko, Sep 08 '21 at 16:34

score 0 · Answer 2 · answered Sep 07 '21 at 23:03

0

Instead of GetDefaultFolder, call Outlook.Application.Session.CreateRecipient, and pass the returned Recipient object to GetSharedDefaultFolder.

answered Sep 07 '21 at 23:03

Dmitry Streblechenko

62,942
4
53
78

Thanks Dmitry, I have been trying to figure out how to implement your suggestion in the above code and still scratching my head. Do I only do this in the "Private Sub Application_Startup()" ? Do you have an example you could share with me? – tangobravo Sep 08 '21 at 13:07

Move Shared Mailbox Email To Folder When Category Assigned

2 Answers2