Consulting

Results 1 to 3 of 3

Thread: SharedMailbox - Move To Folder When Category Assigned

  1. #1

    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

    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

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Gmayor. Thanks that works perfectly.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •