代码之家 › 专栏 › 技术社区 › Stijn Sanders

Outlook VBA:在打开的项目上添加类别

outlook-vba outlook vba

Stijn Sanders · 技术社区 · 15 年前

在Microsoft Outlook VBA中,是否可以捕获任何打开的邮件项目的打开事件?我想在我打开的任何邮件项目中添加一个类别标签,以便有一个可选的“未读”选项,我可以针对它编写脚本。我试过了:

Private Sub MailItem_Open()
    MsgBox "test"
End Sub

2 回复 | 直到 6 年前

Fionnuala 15 年前

可能是以下几点:

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

以上内容应该放在这个观点中。您需要确保安全级别允许宏。

Geoff 6 年前

接受的答案正确地标识了一封打开的电子邮件,但存在一个问题,即如果有另一个类别包含要添加的电子邮件,它将失败。例如,如果类别列表包含 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