Harley Quinn
05-22-2023, 05:44 AM
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
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