发送邮件时如何解决弹出分类？

Question

我使用 VBA 发送电子邮件。每封电子邮件都会弹出一个分类，需要手动设置。我正在尝试在代码中解决这个问题。

我找到了发送电子邮件的代码：Mail a message with outlook via VBA。
在修复了一些东西之后，下面的代码就可以工作了。

Sub sendEmail()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set OutApp = CreateObject("Outlook.Application")
    
    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = cell.Value
            .Subject = "Reminder"
            .Body = "Dear " & Cells(cell.Row, "A").Value _
              & vbNewLine & vbNewLine & _
              "Please Finish your course " & Cells(cell.Row, "C") & _
              " before expiry date."
            .Send  'Or use Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

问题是，从列表中向例如 10 个人发送电子邮件后，我需要点击分类弹出 10 次。

我发现了这个：How to save workbook and handle TITUS (or any other document classification add-in) popup?

我在.Send 之前尝试过.EnableEvents = False。我不确定这是否对我有用。

在我的情况下如何使用它？是否可以禁用它、解决它，甚至在代码中设置一个分类？

Answer 1

有一种解决方法，但您必须在 Outlook Developer 本身中执行此操作。您可以在 Outlook 中设置触发宏的事件处理程序。因此，在这种情况下，Outlook 可以监视使用特定主题行创建的消息（例如），这将触发下面的脚本，从而绕过 TITUS。

'Sets Titus Mail settings and sends mail
    With AOMailMsg
        objMsg.ItemProperties.Add("ABCDE.Registered To", olText) = "My Companies"

        objMsg.ItemProperties.Add("ABCDE.Classification", olText) = "Internal"
        objMsg.UserProperties.Add("ABCDE.Registered To", olText) = "My Companies"
        objMsg.UserProperties.Add("ABCDE.Classification", olText) = "Internal"
        objMsg.UserProperties.Add("TITUSAutomatedClassification", olText) = _
             "TLPropertyRoot=ABCDE;.Registered To=My Companies;.Classification=Internal;"
        objMsg.Send
    End With