Outlook меняет флаг при перемещении в общий почтовый ящик

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

После этого вам необходимо сохранить сообщение - позвоните Mail.Save после установки свойства FlagStatus.

Answer 2

Это то, что вы пытаетесь сделать?

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

Answer 3

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