如何通过VBA为Outlook邮件设置Azure信息保护敏感度标签？

问题背景 #

已有用于Excel工作簿设置AIP敏感度标签的VBA代码，但将代码中的Workbook替换为Outlook MailItem后，无法调用SensitivityLabel.CreateLabelInfo()方法。不想使用草稿模板、SendKeys这类次优方案，寻求直接的Outlook等效实现。

解决方案 #

Outlook的MailItem.SensitivityLabel对象不提供CreateLabelInfo()方法，需直接实例化Office.LabelInfo对象来完成标签设置，以下是完整实现代码：

Function SetOutlookMailSensitivityLabel(mailItem As Outlook.MailItem, lblName As String)
    Dim myLabelInfo As Office.LabelInfo
    Dim context As Object
    Dim curLabelID As String
    
    ' 替换为你的AIP标签ID，可从Azure门户或PowerShell获取
    Dim sPublic As String: sPublic = "788c8a80-3a15-4016-b4c2-fc99999bfa99"
    Dim sGeneral As String: sGeneral = "" ' 若General标签有ID，替换为实际值
    
    ' 根据标签名称匹配对应ID
    Select Case lblName
        Case "General"
            curLabelID = sGeneral
        Case "Public"
            curLabelID = sPublic
        ' 可扩展添加更多标签分支
    End Select
    
    ' 直接实例化LabelInfo对象（Outlook不支持通过SensitivityLabel创建）
    Set myLabelInfo = New Office.LabelInfo
    Set context = CreateObject("Scripting.Dictionary")
    
    With myLabelInfo
        .AssignmentMethod = MsoAssignmentMethod.msoAssignmentMethodPrivileged ' 对应枚举值1
        .ContentBits = 4
        .IsEnabled = True
        .Justification = "业务需求" ' 自定义设置理由
        .LabelId = curLabelID
        .LabelName = lblName
        .SetDate = Now()
    End With
    
    ' 应用敏感度标签到邮件
    mailItem.SensitivityLabel.SetLabel myLabelInfo, context
    ' 保存邮件使标签生效
    mailItem.Save
End Function

使用注意事项 #

• 引用Office库：在VBA编辑器中需勾选Microsoft Office xx.x Object Library（如Office 16.0）；若需后期绑定（避免版本依赖），可将Set myLabelInfo = New Office.LabelInfo替换为Set myLabelInfo = CreateObject("Office.LabelInfo")。
• 标签ID获取：空ID可能导致标签设置失败，可通过Azure信息保护门户或Get-AIPLabel PowerShell命令获取各标签的实际ID。
• 调用示例：创建新邮件后即可调用该函数，例如：

  Dim newMail As Outlook.MailItem
  Set newMail = Outlook.Application.CreateItem(olMailItem)
  Call SetOutlookMailSensitivityLabel(newMail, "Public")
  newMail.Display ' 或直接发送
  

内容的提问来源于stack exchange，提问作者EC99