SharedMailbox - Move To Folder When Category Assigned

Hello,

I have a script that works perfectly on my main inbox. It will automatically move the email to a sub folder when a category is assigned. The sub folder is the same name as the category. However, I cannot get this to work on a shared mailbox in outlook and having trouble figuring out how to modify the code to reference the shared mailbox. Any advice?

My code that works only on main inbox

Code:

---

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

---

In theory the following should work - much depends on the location of the shared mailbox

Code:

---

Option Explicit

Private WithEvents xInboxFld As Outlook.Folder
Private WithEvents xInboxItems As Outlook.Items
Private WithEvents SharedInboxFld As Outlook.Folder
Private WithEvents SharedInboxItems As Outlook.Items
 
Private Sub Application_Startup()
    Set xInboxFld = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
    Set xInboxItems = xInboxFld.Items
    Set SharedInboxFld = Outlook.Application.Session.folders.Item("Shared Folder Name").folders("Inbox") 'use the appropriate folder name
    Set SharedInboxItems = SharedInboxFld.Items
End Sub
 
Private Sub xInboxItems_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 = Application.Session.GetDefaultFolder(olFolderInbox).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
            Application.Session.GetDefaultFolder(olFolderInbox).folders.Add Item.Categories, olFolderInbox
        End If
        Set xTargetFld = Application.Session.GetDefaultFolder(olFolderInbox).folders(Item.Categories)
        Item.Move xTargetFld
    End If
End If
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

---

Gmayor. Thanks that works perfectly.