在移动到共享邮箱时更改标志状态

Question

是否可以更改移动到共享邮箱中文件夹的电子邮件的标志状态？

示例：我收到一封新邮件并用红旗标记。 然后，当工作完成后，我将邮件移动到“已完成”文件夹。

将邮件移动到此文件夹后，我希望 Flagstatus 为“olFlagComplete”（绿旗），每次打开 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

Answer 1

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

2. 第二部分是处理新添加到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

Answer 2

之后您需要保存消息 - 在设置FlagStatus属性后调用Mail.Save 。

Answer 3

这是你想要做的吗？

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