Automatic sensitivity assignment in Excel VBA - Blocks automatic processes in VBA

[Harley Quinn]

Option Explicit

Sub ApproxWS_Size()
Dim wks As Worksheet
    Dim c As Range
    Dim sFullFile As String
    Dim sReport As String
    Dim sWBName As String
Call UnhideAllsheets
sReport = "Size Report"
    sWBName = "Erase Me.xls"
    sFullFile = ActiveWorkbook.Path & _
      Application.PathSeparator & sWBName
' Add new worksheet to record sizes
    On Error Resume Next
Set wks = Worksheets(sReport)
    If wks Is Nothing Then
        With ActiveWorkbook.Worksheets.Add(Before:=Worksheets(1))
            .Name = sReport
            .Range("A1").Value = "Worksheet Name"
            .Range("B1").Value = "Approximate Size"
        End With
    End If
    On Error GoTo 0
    With ActiveWorkbook.Worksheets(sReport)
        .Select
        .Range("A1").CurrentRegion.Offset(1, 0).ClearContents
        Set c = .Range("A2")
    End With
Application.ScreenUpdating = False
    ' Loop through worksheets
    For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> sReport Then
            wks.Copy
            Application.DisplayAlerts = False
Call BeforeSave
            ActiveWorkbook.SaveAs sFullFile
            ActiveWorkbook.Close savechanges:=False
            Application.DisplayAlerts = True
            c.Offset(0, 0).Value = wks.Name
            c.Offset(0, 1).Value = FileLen(sFullFile)
            Set c = c.Offset(1, 0)
            Kill sFullFile
        End If
    Next wks
    Application.ScreenUpdating = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim myLabelInfo As Office.LabelInfo
Set myLabelInfo = ActiveWorkbook.SensitivityLabel.CreateLabelInfo()
        myLabelInfo.LabelName = "Confidential - Internal"
        myLabelInfo.IsEnabled = True
        myLabelInfo.LabelId = "24fb0e8b-8044-4bd6-9e86-77f9d21856dc"
        myLabelInfo.ActionId = "{5cc46055-305d-4bc1-8f5f-5edf82231378}"
        myLabelInfo.AssignmentMethod = MsoAssignmentMethod.PRIVILEGED
ActiveWorkbook.SensitivityLabel.SetLabel myLabelInfo, ActiveWorkbook
End Sub

Sub BeforeSave()
Application.Run "Workbook_BeforeSave", False, False
End Sub

In the "before Save function" I get an error on last rule : ActiveWorkbook.SensitivityLabel.SetLabel myLabelInfo, ActiveWorkbook
>> with folowing error from VBA: Method setlabel of object ' Isensitivity' Failed.
Few monts ago our company has set sensitivity labels as a requirement. I run VBA code where several files need to be created automatically. All automatic jobs come to a halt as when everytime a file is created, the sensitivity is required causing automatic processes to come to a block.

Can anyone help on finding a solution ?

Thank You
Harley


Error_Sensitivity.jpg

[rollis13]

Perhaps, as far as I know SensitivityLabel is a feature of Office 365 and since you don't mention in your profile which version you're using, I'm flipping the coin.

[Harley Quinn]

Version 2303


Capture.jpg

[rollis13]

My chances were only 50%, I'm sorry but I'm of no other help.

[Harley Quinn]

no worries, will look further

[Aussiebear]

Does this give you any hints?

Public WithEvents sensitivityLabel As SensitivityLabel
 
Private Sub sensitivityLabel_LabelChanged(ByVal OldLabelInfo As Office.LabelInfo, ByVal NewLabelInfo As Office.LabelInfo, ByVal HResult As Long, ByVal Context As Object)
 MsgBox "Event raised: " + NewLabelInfo.LabelId
End Sub
 
Sub SetLabelInfo()
Set sensitivityLabel = ActiveDocument.SensitivityLabel
Dim myLabelInfo As Office.LabelInfo
Set myLabelInfo = sensitivityLabel.CreateLabelInfo()
With myLabelInfo
.AssignmentMethod = MsoAssignmentMethod.PRIVILEGED
 .Justification = "Some justification needed only if downgrading label."
 .LabelId = "9203368f-916c-4d59-8292-9f1c6a1e8f39"
 .LabelName = "MyLabelName"
 .SiteId = "6c15903a-880e-4e17-818a-6cb4f7935615"
 End With
 sensitivityLabel.SetLabel myLabelInfo, myLabelInfo
End Sub