Outlook VBA: categoria add on de partidas em aberto

Question

É possível no Microsoft Outlook VBA para pegar o evento Open de qualquer item de correio que fica aberto? Eu gostaria de adicionar um rótulo categoria a qualquer item de correio que abriram, para ter uma opção alternativa 'não lido' Eu poderia script contra para outra coisa. Eu tentei isso:

Private Sub MailItem_Open()
    MsgBox "test"
End Sub

Answer 1

Talvez algo nas linhas de:

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

O acima deve ir ThisOutlookSession. Você vai precisar para assegurar que os seus níveis de segurança permitem macros.

Answer 2

A resposta aceita identifica corretamente um e-mail aberto, mas tem uma questão em que ele irá falhar se não houver outra categoria que contém o que está sendo adicionado. Por exemplo, se a lista de categorias contém Read Later como uma entrada, não será adicionado Read.

Além disso, o separador de lista é codificado, quando na verdade o Outlook usa a um conjunto de configurações regionais.

Para corrigir ambas as abordagens que você pode usar Split() para dividir a lista, pesquisar a lista para o valor, em seguida, Join() para colocá-lo de volta juntos. Isso pode ser feito em conjunto com o separador de lista correta, como ler a partir do Registro.

código Exemplo:

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