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
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