Search code examples
vbaoutlookoutlook-filter

Change Flagstatus on moving to Shared Mailbox


Is it possible to change the Flagstatus of emails moved to a folder in a shared mailbox?

Example: I receive a new mail and mark it with a red flag. Then, when the job is completed, I move the mail to the folder "Completed".

After moving the mail to this folder, I want the Flagstatus to be "olFlagComplete" (Green Flag) and every time I open Outlook, the code should check the folder for mails with red flag (e.g. Mails moved from mobile phone) and set it to green flag.

I tried the following, but nothing happened.

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
    Dim olNameSpace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder

    Set olNameSpace = Application.GetNamespace("MAPI")
    Set olFolder = olNameSpace.Folders("name@company.com")
    Set olFolder = olFolder.Folders("Completed")
    Set Items = olFolder.Items
End Sub

Private Sub Items_ItemChange(ByVal Item As Object)
    Dim olNameSpace As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim Mail As MailItem

    Set olNameSpace = Application.GetNamespace("MAPI")
    Set olFolder = olNameSpace.Folders("name@company.com")
    Set olFolder = olFolder.Folders("Completed")

    If TypeOf Item Is Outlook.MailItem Then
        Set Mail = Item

        If Mail.FlagStatus = olFlagMarked Then
            'Set ItemCopy = Item.Copy ' Copy Flagged item
            'ItemCopy.Move olFolder ' Move Copied item
            Set Mail.FlagStatus = olFlagComplete
        End If

        Set Item = Nothing
        'Set ItemCopy = Nothing
    End If
End Sub

Solution

  • Is this what you are trying to do?

    Option Explicit
    Private Sub Application_Startup()
        Dim Item As Object
        Mark_Items Item
    End Sub
    
    Private Function Mark_Items(ByVal Item As Object)
        Dim olNs As Outlook.NameSpace
        Set olNs = Application.GetNamespace("MAPI")
    
        Dim olShareName As Outlook.Recipient
        Set olShareName = olNs.CreateRecipient("0m3r@email.com")
    
        Dim olShareInbox As Outlook.folder
        Set olShareInbox = olNs.GetSharedDefaultFolder(olShareName, olFolderInbox)
    
        Dim Completed_Fldrs As Outlook.MAPIFolder
        Set Completed_Fldrs = olShareInbox.Folders("Completed")
    
        Dim Filter As String
            Filter = "@SQL=" & Chr(34) & _
                     "http://schemas.microsoft.com/mapi/proptag/0x10900003" & _
                               Chr(34) & ">1"
    
        Dim Items As Outlook.Items
        Set Items = Completed_Fldrs.Items.Restrict(Filter)
    
        Dim Mail As MailItem
    
        Dim i As Long
        For i = Items.Count To 1 Step -1
            DoEvents
            If TypeOf Items(i) Is Outlook.MailItem Then
                Set Mail = Items(i)
                Debug.Print Mail.Subject
                Mail.FlagStatus = olFlagComplete
                Mail.Save
            End If
        Next
    
    End Function