RyanHawkeye
New Member
- Joined
- Apr 9, 2015
- Messages
- 48
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
/****************************************************************************************/
/***************************************************************************************/
/****************************************************************************************/
/****************************************************************************************/
'WB: The workbook you want to change the Sensitivity on
'LblName: General
' Public
' Internal Use
' Confidential
' Restricted
Function SetSensitivityLabel(WB As Workbook, LblName As String)
Dim myLabelInfo As Office.LabelInfo
Dim Context As Variant
Dim objWorkbook As Workbook
Dim CurLabelID As String
Dim sPublic As String
Dim sGeneral As String
Dim sInternal_Use As String
Dim sConfidential As String
Dim sRestricted As String
Set objWorkbook = ActiveWorkbook
Set myLabelInfo = objWorkbook.SensitivityLabel.CreateLabelInfo()
Set Context = CreateObject("Scripting.Dictionary")
sPublic = "174b6716-c2ea-4041-b631-5633733fbe46-8420s"
sInternal_Use = "1f9c9bcd-f315-4c3b-87a0-7682e230e7e4-8420z"
sConfidential = "eb0be65c-43df-47d1-8c45-69f1d3d476a9-8420p"
sRestricted = "48d9d89d-06ce-4535-b1a5-059e3329e9c8-8420n"
Select Case LblName
Case "General"
CurLabelID = sGeneral
Case "Public"
CurLabelID = sPublic
Case "Internal Use"
CurLabelID = sInternal_Use
Case "Confidential"
CurLabelID = sConfidential
Case "Restricted"
CurLabelID = sRestricted
End Select
With myLabelInfo
.AssignmentMethod = MsoAssignmentMethod.PRIVILEGED '1
.ContentBits = 4
.IsEnabled = True
.Justification = "Because" 'Make this whatever you want
.LabelId = CurLabelID
.LabelName = LblName
.SetDate = Now()
End With
objWorkbook.SensitivityLabel.SetLabel myLabelInfo, Context
End Function
/*** The below Part identifies the Sensitivity IDs for sPublic, sInternal Use, sConfidential, and sRestricted that I have manually put in the code above ****/
Sub GetSensitivityID()
Dim myLabelInfo As Office.LabelInfo
Set myLabelInfo = ActiveWorkbook.SensitivityLabel.GetLabel()
Debug.Print myLabelInfo.LabelId
End Sub
/****** The below is the END GOAL of the VBA above to change the Label of the Spreadsheet to what you want it to be ****/
Sub SetSLabel()
SetSensitivityLabel ActiveWorkbook, "Confidential"
End Sub
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
/****************************************************************************************/
/***************************************************************************************/
COMBINE VBA Above to the VBA Below so it runs as one Code
/****************************************************************************************/
/****************************************************************************************/
'WB: The workbook you want to change the Sensitivity on
'LblName: General
' Public
' Internal Use
' Confidential
' Restricted
Function SetSensitivityLabel(WB As Workbook, LblName As String)
Dim myLabelInfo As Office.LabelInfo
Dim Context As Variant
Dim objWorkbook As Workbook
Dim CurLabelID As String
Dim sPublic As String
Dim sGeneral As String
Dim sInternal_Use As String
Dim sConfidential As String
Dim sRestricted As String
Set objWorkbook = ActiveWorkbook
Set myLabelInfo = objWorkbook.SensitivityLabel.CreateLabelInfo()
Set Context = CreateObject("Scripting.Dictionary")
sPublic = "174b6716-c2ea-4041-b631-5633733fbe46-8420s"
sInternal_Use = "1f9c9bcd-f315-4c3b-87a0-7682e230e7e4-8420z"
sConfidential = "eb0be65c-43df-47d1-8c45-69f1d3d476a9-8420p"
sRestricted = "48d9d89d-06ce-4535-b1a5-059e3329e9c8-8420n"
Select Case LblName
Case "General"
CurLabelID = sGeneral
Case "Public"
CurLabelID = sPublic
Case "Internal Use"
CurLabelID = sInternal_Use
Case "Confidential"
CurLabelID = sConfidential
Case "Restricted"
CurLabelID = sRestricted
End Select
With myLabelInfo
.AssignmentMethod = MsoAssignmentMethod.PRIVILEGED '1
.ContentBits = 4
.IsEnabled = True
.Justification = "Because" 'Make this whatever you want
.LabelId = CurLabelID
.LabelName = LblName
.SetDate = Now()
End With
objWorkbook.SensitivityLabel.SetLabel myLabelInfo, Context
End Function
/*** The below Part identifies the Sensitivity IDs for sPublic, sInternal Use, sConfidential, and sRestricted that I have manually put in the code above ****/
Sub GetSensitivityID()
Dim myLabelInfo As Office.LabelInfo
Set myLabelInfo = ActiveWorkbook.SensitivityLabel.GetLabel()
Debug.Print myLabelInfo.LabelId
End Sub
/****** The below is the END GOAL of the VBA above to change the Label of the Spreadsheet to what you want it to be ****/
Sub SetSLabel()
SetSensitivityLabel ActiveWorkbook, "Confidential"
End Sub