使用 Outlook VBA 为所有选定的电子邮件添加类别

Add a category for all selected emails using Outlook VBA

我正在尝试使用 VBA 为在 Outlook 中选择的每封电子邮件添加一个类别。

问题是下面的代码仅将类别添加到 第一 封电子邮件。

我使用的是 Outlook 2016。

Public Sub MarkSelectedAsGreenCategory()
    Dim olItem As MailItem
    
    Dim newCategory As String
    newCategory = "Green category"
    
    Dim i As Integer
    
    For i = 1 To Application.ActiveExplorer.Selection.Count
        Set olItem = Application.ActiveExplorer.Selection(i)
        AddCategory olItem, newCategory
        Set olItem = Nothing
    Next
      
End Sub

Private Sub AddCategory(mailItem 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(mailItem.categories, listSep)

    ' Search the array for the new category, 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
        mailItem.categories = Join(categories, listSep)
    End If
End Sub

更新 ActiveInspector.CurrentItem 上的类别会生成保存提示。

选择:

olItem.SavemailItem.Save 在您方便的时候。