VBA not functioning completely - protect sheets and workbooks

[dinhaopoto]

Being new to the VBA band wagon, i'm having some issues troubleshooting the code below. It is supposed to be able to choose multiple excel files in a folder and protect all of the worksheets within them as well as each workbook. The protect of the workbook does not have a password, it is simply to avoid ign**** people from deleting or moving the sheets. The protect of the sheets itself does have a password so no one can change anything, not even select it to copy and paste elsewhere. Currently, the code seems to be working partially as it only does all of that to the first workbook only.

Need help. There are over 2,000 workbooks with multiple worksheets that need to be protected. The workbooks are a mix of .xls and .xlsx, I do have a macro to ultimately convert all of the .xls to .xlsx which seems to be working as of now (I'm not sure if this extra info is helpful in any way)

Sub SaveEncrypted()


Dim FilesToOpen
Dim filecounter As Integer
Dim wbName As String
Dim rowcounter As Integer


On Error GoTo ErrHandler
Application.ScreenUpdating = False


FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Excel Workbooks (*.xlsx),*.xslx", _
MultiSelect:=True, Title:="Files to Encrypt")


If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If


Application.DisplayAlerts = False


filecounter = 1
rowcounter = 2


While filecounter <= UBound(FilesToOpen)


Workbooks.Open Filename:=FilesToOpen(filecounter), Local:=True


    
Dim wSheet As Worksheet
Dim Pwd As String
Pwd = InputBox("Enter your password to protect all worksheets", "Password Input")
For Each wSheet In Worksheets
wSheet.Protect Password:=Pwd, DrawingObjects:=True, Contents:=True, Scenarios:= _
        True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True
        wSheet.EnableSelection = xlNoSelection
Next wSheet
Dim wbk As Workbook
wbName = ActiveWorkbook.Name
For Each wbk In Workbook
wbk.Protect Structure:=True, Windows:=True
wbk.SaveAs Filename:= _
wbk.Name, FileFormat:=51, _
ReadOnlyRecommended:=False, CreateBackup:=False


wbk.Close
Next wbk


Windows("SaveEncrypted.xlsx").Activate
Sheets(ActiveSheet.Name).Select
Range("A" & rowcounter).Value = wbName






filecounter = filecounter + 1
rowcounter = rowcounter + 1




Wend


Application.DisplayAlerts = True
Sheets(ActiveSheet.Name).Cells.Select
Cells.EntireColumn.AutoFit


ExitHandler:
Application.ScreenUpdating = True
Exit Sub


ErrHandler:


End Sub

Any help is appreciated as I'm killing myself over this! Thanks!!