SharedMailbox - Move To Folder When Category Assigned

[tangobravo]

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



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.Categ ories)
xMailItem.Move xTargetFld
End If
End If
End Sub

[gmayor]

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

[tangobravo]

Gmayor. Thanks that works perfectly.