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


30832

[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


30833

[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