使用 vba 进行 Azure 分类

Question

我有一个宏可以创建和保存多个 word 和 excel 文档。最近，我的组织开始使用 Microsoft Azure 保护。它总是要求用户在保存文档时选择分类标签。有没有办法可以从 VBA 传递标签？（即通过代码控制分类）

我试图搜索现有的问题，但没有运气。

Answer 1

看来一年多过去了，依然没有解决办法。至少我没有找到任何 AIP 的本机 VBA 集成。

不过我为自己找到了解决方案。基本上，我现在手动创建邮件草稿，并手动选择分类。该草稿保留在 Outlook 中的一个特殊文件夹中。一旦我需要通过 VBA 发送邮件，我就会复制草稿（包括分类！），更改收件人、对象、正文，并且无需 VBA 的用户交互即可发送邮件，因为分类已经完成。

Private Sub Email()
    Dim oMailItem As Outlook.MailItem
    'Set oMailItem = Outlook.Application.CreateItem(olMailItem)
    'Choose template according to subject
    'I have one template for each sensitivity classification
    Set oMailItem = getVbaTemplateMail("VBA Template - Sensitivity=General")
    With oMailItem
    .To = "mail@a.b"
    .subject = "Email Test using VBA"
    .Body = "Test"
    .Display
    .Send
    End With
    Set oMailItem = Nothing
End Sub

Private Function getVbaTemplateMail(subject As String) As Outlook.MailItem
    Dim olFolder  As Outlook.MAPIFolder
    Dim olItem As Outlook.MailItem
    'GetDefaultFolder(16) = Draft folder, "Drafts/VBA Templates" is my VBA Template folder
    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(16).Folders("VBA Templates")
    For Each olItem In olFolder.Items
        Debug.Print olItem.subject ' Print to immediate window
        If olItem.subject = subject Then
            Set getVbaTemplateMail = olItem.Copy
            'If error "Active Inline Response" appears, the mail is open in Outlook, close it first!
            Exit Function
        End If
    Next
End Function

Answer 2

我至少找到了 Excel 的解决方案。我正在使用与HaPi for Outlook类似的方法。

首先，设置一个标签并使用以下代码检查所选标签的对象详细信息（例如在Locals窗口中）：

Set current_label = ThisWorkbook.SensitivityLabel.GetLabel()

然后在新工作簿中创建label_info对象并用对象的详细信息填充它current_label：

Set label_info = ActiveWorkbook.SensitivityLabel.CreateLabelInfo

With label_info
      .ActionId = "" 'fill
      .AssignmentMethod = MsoAssignmentMethod.PRIVILEGED 'fill
      .ContentBits = 0 'fill
      .IsEnabled = True
      .Justification = "" 'fill
      .LabelId = "" 'fill
      .LabelName = "" 'fill
      .SetDate = Now()
      .SiteId = "" 'fill
End With

最后SetLabel()在当前工作簿上使用：

ActiveWorkbook.SensitivityLabel.SetLabel label_info, CreateObject("scripting.dictionary")

笔记：

• 更改不会立即可见，标签设置在后台。
• 使用标签选择保存文件时没有消息框。
• 重新打开excel后，标签正常被选中。
• 我不确定第二个Context参数在函数中的SetLabel()作用，所以我刚刚在那里创建了空对象

测试用例：

Sub set_label()
    ' Select label first
    Set current_label = ThisWorkbook.SensitivityLabel.GetLabel()
    
    msgbox "Check current_label details and fill below parameters"
    debug.assert False

    Workbooks.Add

    Set label_info = ActiveWorkbook.SensitivityLabel.CreateLabelInfo

    With label_info
          .ActionId = "" 'fill
          .AssignmentMethod = MsoAssignmentMethod.PRIVILEGED 'fill
          .ContentBits = 0 'fill
          .IsEnabled = True
          .Justification = "" 'fill
          .LabelId = "" 'fill
          .LabelName = "" 'fill
          .SetDate = Now()
          .SiteId = "" 'fill
    End With

    ActiveWorkbook.SensitivityLabel.SetLabel label_info, CreateObject("scripting.dictionary")
    ActiveWorkbook.SaveAs Environ("USERPROFILE") & "\Desktop\wb with label.xlsx"
    Workbooks("wb with label.xlsx").Close True
End Sub

其他资源：

1. https://learn.microsoft.com/pl-pl/office/vba/api/office.labelinfo

2. https://learn.microsoft.com/pl-pl/office/vba/api/office.sensitivitylabel