I have a script that loops through the files in a choosen folder and is supposed to protect or unprotect the workbook depending on what the user types into a Application.InputBox.
The script will cycle through the files but does not either protect or unprotect them as expected. And from all my research, the code seems to be correct.
I am looking for a little guidance with the code below.
I have sectioned off the part I need help with.
Sub RemovePassword()
'Modified from a post from Stack
'https://stackoverflow.com/questions/53885596/remove-password-from-excel-files
' String Lists
Const cStrExtensions As String = "*.xls*"
Const cStrPassword As String = "*knights"
Dim strFolderPath As String ' Search Folder
Dim strFileName As String ' Current File Name (Workbook)
Dim iCost As Long
Dim MyValue As String
Dim Response As String
'Confirm that the user wants to complete action
If MsgBox("This action will Lock or Unlock sensitive salary files, " & vbNewLine & _
"Do you want to continue? ", vbCritical + vbYesNo, "WARNING") = vbYes Then
'Ask the user what they want to do, lock or unlock
' Display dialog box
MyValue:
MyValue = UCase(Application.InputBox(Prompt:="This action will Lock or Unlock Salary files" & vbNewLine & _
"What would you like to do, Lock or Unlock?", Title:="WHAT CHA WANNA DO??"))
' 'I NEED HELP WITH THIS BIT. will post a seperate post for this question
' ' Want to test if the user entered a correct value before proceeding
' If MyValue <> "LOCK" Or MyValue <> "UNLOCK" Then
' Response = MsgBox("You only Have 2 Choices, Locked or Unlocked", vbYesNo, "TRY AGAIN?")
' If Response = vbYes Then
' GoTo MyValue
' Else
' MsgBox "Check Ya Later"
' End If
' Exit Sub
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
With ThisWorkbook.ActiveSheet
' Choose Search Folder
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
strFolderPath = .SelectedItems(1) & "\"
End With
' Loop through folder to determine Current File Name (Workbook).
' Use the cost center as part of the password
strFileName = Dir(strFolderPath & cStrExtensions)
iCost = Trim(Left(strFileName, InStr(strFileName, " ") - 1))
' Debug.Print strFileName
' Debug.Print iCost
' Loop through files in folder.
Do While strFileName <> ""
' Open each file in folder
'Workbooks.Open strFolderPath & strFileName
Workbooks.Open Filename:=strFolderPath & strFileName, _
Password:=iCost & cStrPassword
'####################################################################################
' I NEED HELP WITH THIS PART
' THE PROTECT AND UNPROTECT DO NOT SEEM TO BE DOING WHAT THEY ARE SUPPOSED TO
' I DO NOT GET AN ERROR
Select Case MyValue
'Lock all files in the folder
Case Is = "LOCK"
With ActiveWorkbook
.Protect Password:=iCost & cStrPassword, Structure:=True, Windows:=True
.Close True
End With
'Unlock all files in the folder
Case Is = "UNLOCK"
With ActiveWorkbook
.Unprotect iCost & cStrPassword
.Close True
End With
End Select
'####################################################################################
strFileName = Dir()
' Exclude this workbook.
If .Parent.Name = strFileName Then strFileName = Dir()
Loop
End With
ProcedureExit:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
'Exit if user clicks no
Else
MsgBox "D'OH! ", vbInformation, "CHECK YA LATER!"
End If
Exit Sub
'End the MyValue test
'End If
End Sub
Bookmarks