Change Flagstatus on moving to Shared Mailbox

Question

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("[email protected]")
    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("[email protected]")
    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

Answer 1

1. The first task is to mark all completed items with a green flag at startup:

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("[email protected]")
    Set olFolder = olFolder.Folders("Completed")
    Set Items = olFolder.Items
    For Each Item In Items
      If TypeOf Item Is Outlook.MailItem Then
        Set Mail = Item

        If Mail.FlagStatus = olFlagMarked Then
            Set Mail.FlagStatus = olFlagComplete
        End If
      End If
     Next 

End Sub

2. The second part is to handle newly added items to the Completed folder:

Private Sub Items_ItemAdd(ByVal Item As Object)  
    If TypeOf Item Is Outlook.MailItem Then
        Set Mail = Item

        If Mail.FlagStatus = olFlagMarked Then            
            Set Mail.FlagStatus = olFlagComplete
        End If        
    End If
End Sub

Answer 2

You need to save the message afterwards - call Mail.Save after setting the FlagStatus property.

Answer 3

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("[email protected]")

    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