Question

我的老板要求我根据我们的excel表单找到发送电子邮件的方法。我搜索并发现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

...但问题是

在我公司有弹出分类加载项（TITUS）。所以在从列表发送电子邮件之后 - 例如10个人 - 我需要点击分类弹出10次，每封电子邮件。我搜索过，这是可以避免的。我找到了这个。 How to save workbook and handle TITUS (or any other document classification add-in) popup?

我对VBA并不熟悉。我尝试在.EnableEvents = False无效之前添加.Send。我甚至不确定这是否能为我服务。

如何在我的情况下使用它？它可行吗？禁用它可以解决它，甚至在代码中设置分类。

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

发送电子邮件和解决方法弹出分类（TITUS）

...但问题是

1 个答案: