In theory the following should work - much depends on the location of the shared mailbox
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