Outlook在移动到共享邮箱时更改Flagstatus

是否可以从我已移至共享邮箱中的文件夹的电子邮件中更改flagstatus？

示例：我收到一封新邮件，并用红色标记标记它。然后，当作业完成时，我将邮件移至“已完成”文件夹。

将邮件移动到此文件夹后，我希望flagstatus为“ olflagComplete”（绿色标记），并且每次打开Outlook时，代码都应检查带有红色标记的邮件文件夹（例如，从手机中移动的邮件）并将其设置为绿色标记。

我尝试了以下操作，但是在打开的Outlook中什么也没发生。

希望有人可以帮助我。

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


1. 第一个任务是在启动时用绿色标记标记所有已完成的项目：

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


1. 第二部分是处理新添加到Completed文件夹中的项目：

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

,

您需要随后保存邮件-设置Mail.Save属性后调用FlagStatus。

这是您要做什么吗？

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