' Code to add Password to Excel file.
' following loop is used to get files from "n" numbers of subfolders...
' Note: This will set password to non-password without prompting, but the file already have the password will get prompt to enter old password before it set new one.
Public Sub addPassword()
Dim FSO As Object
Dim folder As Object, subfolder As Object
Dim wb As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
folderPath = ActiveSheet.Range("A1").Value ' you can hardcore the path or put it in the cell
pwd = ActiveSheet.Range("B1").Value ' you can hardcore the password or put it in the cell
Set folder = FSO.GetFolder(folderPath)
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
End With
' loop to get root files of the mention folder path..
For Each wb In folder.Files
If Right(wb.Name, 3) = "xls" Or Right(wb.Name, 4) = "xlsx" Or Right(wb.Name, 4) = "xlsm" Then
Set masterWB = Workbooks.Open(wb)
ActiveWorkbook.SaveAs Filename:=Application.ActiveWorkbook.FullName, Password:=pwd
ActiveWorkbook.Close True
End If
Next
' following loop is used to get files from "n" numbers of subfolders...
For Each subfolder In folder.SubFolders
For Each wb In subfolder.Files
If Right(wb.Name, 3) = "xls" Or Right(wb.Name, 4) = "xlsx" Or Right(wb.Name, 4) = "xlsm" Then
Set masterWB = Workbooks.Open(wb)
ActiveWorkbook.SaveAs Filename:=Application.ActiveWorkbook.FullName, Password:=pwd
ActiveWorkbook.Close True
End If
Next
Next
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.AskToUpdateLinks = True
End With
End Sub
