Outlook VBA: добавить категорию в открытый элемент

Question

Возможно ли в Microsoft Outlook VBA перехватывать событие Open любого почтового элемента, который открывается? Я хотел бы добавить метку категории к любому открытому почтовому элементу, чтобы иметь альтернативный вариант «непрочитанный», который я мог бы использовать для сценария для чего-то другого. Я пробовал это:

Private Sub MailItem_Open()
    MsgBox "test"
End Sub

Answer 1

Возможно, что-то вроде:

Public WithEvents myOlInspectors As Outlook.Inspectors
Public myInspectorsCollection As New Collection

Private Sub Application_Startup()
    Initialize_handler
End Sub

Public Sub Initialize_handler()
    Set myOlInspectors = Application.Inspectors
End Sub

Private Sub myOlInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
If (Inspector.CurrentItem.Class = olMail) Then

    If Inspector.CurrentItem.Parent = "Inbox" Then
        strCats = Inspector.CurrentItem.Categories

        If InStr(strCats, "Read") = 0 Then
            If Not strCats = vbNullString Then
                strCats = strCats & ","
            End If
            strCats = strCats & "Read"
            Inspector.CurrentItem.Categories = strCats
            Inspector.CurrentItem.Save
        End If
    End If
End If
End Sub

Выше должно идти в ThisOutlookSession. Вам нужно будет убедиться, что ваши уровни безопасности позволяют использовать макросы.

Answer 2

Принятый ответ правильно идентифицирует открытое электронное письмо, но имеет проблему в том, что он потерпит неудачу, если есть другая категория, которая содержит добавляемую. Например, если список категорий содержит Read Later в качестве записи, Read не будет добавлено.

Кроме того, разделитель списка жестко закодирован, когда фактически Outlook использует тот, который установлен в региональных настройках.

Чтобы исправить оба этих подхода, вы можете использовать Split(), чтобы разбить список, найдите в списке значение, затем Join(), чтобы собрать его вместе. Это можно сделать в сочетании с правильным разделителем списка, как считывается из реестра.

Пример кода:

Public WithEvents myOlInspectors As Outlook.Inspectors
Public myInspectorsCollection As New Collection

Private Sub Application_Startup()
    Initialize_handler
End Sub

Public Sub Initialize_handler()
    Set myOlInspectors = Application.Inspectors
End Sub

Private Sub myOlInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
    If (Inspector.CurrentItem.Class = olMail) Then
        If Inspector.CurrentItem.Parent = "Inbox" Then
            AddCategory Inspector.CurrentItem, "Read"
            Inspector.CurrentItem.Save
        End If
    End If
End Sub

Sub AddCategory(aMailItem As MailItem, newCategory As String)
    Dim categories() As String
    Dim listSep As String

    ' Get the current list separator from Windows regional settings
    listSep = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\International\sList")

    ' Break the list up into an array
    categories = Split(aMailItem.categories, listSep)

    ' Search the array for the new cateogry, and if it is missing, then add it
    If UBound(Filter(categories, newCategory)) = -1 Then
        ReDim Preserve categories(UBound(categories) + 1)
        categories(UBound(categories)) = newCategory
        aMailItem.categories = Join(categories, listSep)
    End If
End Sub