Need Help Applying Sensitivity Label to My Current VBA Code

[RyanHawkeye]

I need the following code to automatically overwrite the old file without it popping up the spreadsheet to manually ask me if I want to overwrite the spreadsheet. Another important part I need is the Sensitivity Lable to show as "Confidential" prior to saving the Spreadsheets. Below is what code I have so far. Any help will be very much appreciated. Thanks!

Option Explicit
Sub KeepSpecificSheets()
Dim FolderPath As String
Dim Filename As String
Dim wb As Workbook
Dim ws As Worksheet
Dim MasterWorkbook As Workbook
Dim KeepSheets As Object
Dim wsName As String
Dim FoundSheet As Boolean

Application.DisplayAlerts = False

' Set the folder path

FolderPath = "C:\Your\Folder\Path\" ' Change this to your folder path

If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"

' Store the master workbook

Set MasterWorkbook = ThisWorkbook

' Define sheets to keep in a dictionary

Set KeepSheets = CreateObject("Scripting.Dictionary")

KeepSheets.Add "AR20", True
KeepSheets.Add "AR21", True
KeepSheets.Add "VT77", True
KeepSheets.Add "GG65", True


' Loop through all xlsx files in the folder
Filename = Dir(FolderPath & "*.xlsx")
Do While Filename <> ""
' Open the workbook if it is not the master workbook
If StrComp(FolderPath & Filename, MasterWorkbook.FullName, vbTextCompare) <> 0 Then
Set wb = Workbooks.Open(FolderPath & Filename)
FoundSheet = False ' Initialize flag

' Check if any sheets to keep exist
For Each ws In wb.Worksheets
If KeepSheets.exists(ws.Name) Then
FoundSheet = True
Exit For
End If
Next ws

' If no sheets match the keep list, delete the workbook
If Not FoundSheet Then
Application.DisplayAlerts = False
wb.Close SaveChanges:=False ' Close without saving changes
Kill FolderPath & Filename ' Delete the file
Application.DisplayAlerts = True
Else
' Loop through all worksheets in the workbook to delete non-matching sheets

For Each ws In wb.Worksheets
wsName = ws.Name
If Not KeepSheets.exists(wsName) Then
Application.DisplayAlerts = False
ws.Visible = xlSheetVisible ' Make sheet visible if hidden
ws.Delete
Application.DisplayAlerts = True
End If
Next ws

Application.DisplayAlerts = False
' Save and close the workbook
wb.Close SaveChanges:=True
Application.DisplayAlerts = True
End If
End If

' Get the next file
Filename = Dir
Loop

Application.DisplayAlerts = True

MsgBox "Process Completed!", vbInformation
End Sub

 

[MARK858]

See if the post in the link below helps (please note that I can't amend it as I am not at work to be able to test it)

VBA Error _ Add Sensitivity label

Hi Team, While saving a workbook via vba , I am getting one pop up message Add Sensitivity label , how to disable this message. via vba please help. thanks in advance ! I am getting erorr at at below line nwbk.SaveAs Filename:=newFilePath, FileFormat:=xlOpenXMLWorkbook Sub test() Dim...

www.mrexcel.com