How to change passwords of all open workbook

[nagovind]

Dear All,

There are many worksheets currently open

Say 5 sheets are open

All are already password protected to open it, but it is open

Password is known

How to change the old password to new one and SAVE and close it so that while opening it will be supplied with new passwords

Any codes please

Regards
Govind

 

[Luke M]

Assuming you are talking about workbooks, and not the worksheet protection password, this code will loop through all open workbooks and change the password on them.

Sub ChangePass()
Dim newPass As String
Dim checkPass As String
Dim wb As Workbook

restart:
'Get new password
newPass = InputBox("What is the new password?")
checkPass = InputBox("Please confirm password")

'Make sure user didn't make a typo
If newPass <> checkPass Then
    MsgBox "Passwords don't match. Try again"
    GoTo restart
End If

Application.ScreenUpdating = False
For Each wb In Application.Workbooks
    'Set new password
    wb.SaveAs wb.FullName, , newPass
    'Can't close the workbook running the code
    If wb.Name <> ThisWorkbook.Name Then wb.Close
Next wb
Application.ScreenUpdating = True

End Sub

Note that it doesn't close the workbook containing this code...aka, 1 workbook will still be open at the end.

 

[nagovind]

Dear Luke,

Thanks for the code
Yes all are open workbooks and not worksheets sorry

While running the code i got the below errors please do the needful

 

[nagovind]

Attached is the example file
It is password protecting the PERSONAL workbook internal to excel

Please do the needful
Regards
Govind

 

[nagovind]

Password of the example file is aaa

 

[nagovind]

After replacing a line with the yellow highlighted it seems it is working

 

[Luke M]

Several questions here.

Error message about file already existing:
This is because we are doing a SaveAs over the previous file. I should have surrounded that line of code with errors turned off, like so:

   Application.DisplayAlerts = False
   wb.SaveAs wb.FullName, , newPass
   Application.DisplayAlerts = True

Can't access read-only file:
Macro assumed that all files are open and editable. If this is not the case, we can't make changes to the file...what should we do in this case? Ignore it?

Changed line to Workbook.Protect:
This does something very different. My original code (and what I thought you wanted) applied a password needed to open the file. The new line simply protects the workbook structure so someone can't delete/change sheets. Which did you really want?

 

[nagovind]

Dear Luke,

Sorry the code i have posted is only protecting the structure, i found that after posting this reply

I need to protect the workbook with password

BELOW CODE IS PERFECTLY ALRIGHT

THANK YOU LUKE!

Sub ChangePass()

Dim newPass As String
Dim checkPass As String
Dim wb As Workbook

restart:
'Get new password
newPass = InputBox("What is the new password?")
checkPass = InputBox("Please confirm password")

'Make sure user didn't make a typo
If newPass <> checkPass Then
    MsgBox "Passwords don't match. Try again"
    GoTo restart
End If

Application.ScreenUpdating = False

For Each wb In Application.Workbooks
    'Set new password
    Application.DisplayAlerts = False
    wb.SaveAs wb.FullName, , newPass    'Can't close the workbook running the code
    Application.DisplayAlerts = False
Next wb

Application.ScreenUpdating = True
ThisWorkbook.Save
Application.Quit

End Sub