Your code after the fix is pretty good, although you trusted me too much. 
For example. This condition will never be met:
If TypeName(MyValue) = "Boolean" Then Exit Sub
I wrote it wrong.
This snippet won't necessarily work either:
Select Case MyValue
' LOCK all files in the folder
Case Is = "LOCK"
You mistakenly assumed that the user would type words in capital letters. And before that, you didn't convert user responses to uppercase.
This code construction is very dangerous:
With ActiveWorkbook
.SaveAs Filename:= ...
.Close
End With
The explanation is going to be a little tricky.
Before explaining the problem with the cited code, you need to know what happens when you use SaveAs. This command saves the workbook under a new name, the "source" workbook is abandoned (closed without saving changes), and the active workbook is already a new instance of the "source" workbook.
With ActiveWorkbook refers to the active workbook. And everything inside that construction refers to what comes after With, which is the "source" workbook.
.SaveAs still refers to the correct workbook, but .Close does not. You are trying to close a workbook that is no longer there because it was abandoned when you saved it. But do not worry. You are not alone. Even though I know about this trap, I made this mistake a moment ago. 
Sometimes a folder may contain temporary files that are created when you open a particular workbook. After the file is properly closed, the temporary file is deleted by Excel. However, when a file is closed abruptly (due to a fatal error), the temporary file may remain on disk. They start with a tilde (~), but the file extension is the same as the actual file. Temporary files have a very different structure and you may get an error when you open them in Excel. When looping through files, exclude them.
It's mine now.
I don't trust the Dir() function, so I use File System Object. This makes the code longer. Besides, I like "rich" code. In addition, I pay more attention to the safe execution of the code. You can apply it, or you can stay with yours, provided that you correct the mistakes I mentioned.
Sub ToggleProtectWorkbooks()
Const cstrProcedure = "ToggleProtectWorkbooks"
Const cstrPattern As String = "[!~]*.xls*" 'Excel files, no temp files
Const cStrPassword As String = "*knights" 'The second part of password
Dim strFolderPath As String ' Search Folder
Dim vFileName As Variant ' Current File Name (Workbook)
Dim varrList As Variant ' Array of filtered files in a folder
Dim vCost As Variant
Dim iCost As Long
Dim MyValue As String
Dim Answer As Variant
Dim lAutoSecur As MsoAutomationSecurity
Dim FSO As Object
On Error GoTo HandleError
lAutoSecur = Application.AutomationSecurity
'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? ", vbExclamation + vbYesNo + vbDefaultButton2, "WARNING") = vbYes Then
'Ask the user what they want to do, lock or unlock
' Display dialog box
TryAgain:
Answer = UCase(InputBox(Prompt:="This action will Lock or Unlock Salary files" & vbNewLine & _
"What would you like to do, (L)ock or (U)nlock?", Title:="WHAT CHA WANNA DO??"))
If Len(Trim(Answer)) = 0 Then Exit Sub
'Take only the first letter of the answer
MyValue = Left(UCase(Answer), 1)
Select Case MyValue
Case "L", "U"
Case Else
MsgBox "You only Have 2 Choices, Locked or Unlocked", vbExclamation
GoTo TryAgain
End Select
' Choose Search Folder
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = False Then Exit Sub
strFolderPath = .SelectedItems(1) & "\"
End With
'Array of filtered files in a folder (Full paths)
varrList = ArrayFiles(strFolderPath, cstrPattern)
If UBound(varrList) < 0 Then
MsgBox "No files found in the folder!", vbExclamation
Exit Sub
End If
With Application
.ScreenUpdating = False
.DisplayAlerts = False
'Disable macros in files you open
.AutomationSecurity = msoAutomationSecurityForceDisable
End With
Set FSO = CreateObject("Scripting.FileSystemObject")
' Loop through the files in a folder.
' Use the cost center as part of the password
For Each vFileName In varrList
'The first word in file name before the space
vCost = Split(Trim(GetFileNameFSO(CStr(vFileName), FSO)))(0)
If IsNumeric(vCost) Then
iCost = vCost
SaveBookAndClose CStr(vFileName), iCost & cStrPassword, MyValue = "L"
DoEvents
Else
Debug.Print "File skipped: " & vFileName
End If
Next vFileName
Else
MsgBox "D'OH! ", vbInformation, "CHECK YA LATER!"
End If
MsgBox "Done"
HandleExit:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AutomationSecurity = lAutoSecur
End With
Set FSO = Nothing
Exit Sub
HandleError:
MsgBox Err.Number & vbLf & Err.Description & vbLf & _
"in: " & cstrProcedure, vbCritical, "Error"
Resume HandleExit
End Sub
Sub SaveBookAndClose(sFileName As String, sPass As String, blnProtect As Boolean)
Dim wkb As Workbook
Set wkb = Workbooks.Open(Filename:=sFileName, Password:=sPass)
wkb.SaveAs Filename:=sFileName, Password:=IIf(blnProtect = True, sPass, "")
Set wkb = ActiveWorkbook
wkb.Close False
End Sub
Function ArrayFiles(ByVal sFolder As String, Optional sFilter As String, Optional FSO As Object) As Variant
Dim fsoFolder As Object
Dim fsoFile As Object
Dim i As Long
Dim oDic As Object
Dim IsNotFSO As Boolean
Dim objFSO As Object
Set objFSO = FSO
If objFSO Is Nothing Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
IsNotFSO = True
End If
Set oDic = CreateObject("Scripting.Dictionary")
If objFSO.FolderExists(sFolder) Then
Set fsoFolder = objFSO.GetFolder(sFolder)
If Len(sFilter) = 0 Then sFilter = "*.*"
For Each fsoFile In fsoFolder.Files
If UCase(fsoFile.Name) Like UCase(sFilter) Then
oDic.Add fsoFile.Path, 0
End If
Next fsoFile
End If
Set fsoFolder = Nothing
If IsNotFSO Then
Set objFSO = Nothing
End If
ArrayFiles = oDic.Keys()
End Function
Function GetFileNameFSO(strFileFullPath As String, Optional FSO As Object) As String
Dim IsNotFSO As Boolean
Dim objFSO As Object
Dim oFile As Object
Set objFSO = FSO
If objFSO Is Nothing Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
IsNotFSO = True
End If
If objFSO.FileExists(strFileFullPath) Then
GetFileNameFSO = objFSO.GetFileName(strFileFullPath)
End If
If IsNotFSO Then
Set objFSO = Nothing
End If
End Function
Artik
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks