Question

是否可以从我已移至共享邮箱中的文件夹的电子邮件中更改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

Answer 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

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

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

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

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

3 个答案: