400 Error in Unprotect/Protect Macro

Y

Youngergirl44

I have several workbooks that contain about 100 sheets each. Some sheets are
not protected while the rest are protected with one of three passwords. I'm
trying to write a macro that will allow me to protect all sheets and assign
them all a new password. So I want it to first check if the sheet is
protected. If not, protect and assign "newpass" as password. If protected,
try to unprotect with "pass1". If that doesn't work, try "pass2" and then
"pass3" if needed. Once the sheet is unprotected, reprotect it and assign
"newpass" as the password. Then move on to the next sheet and repeat.

The following code is what I've come up with so far:

Sub I_Hope_This_Works()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.ProtectContents = False Then
ws.Protect (newpass)
Else: ws.Unprotect (pass1)
If ws.ProtectContents = True Then
ws.Unprotect (pass2)
If ws.ProtectContents = True Then
ws.Unprotect (pass3)
ws.Protect (newpass)
End If
ws.Protect (newpass)
End If
ws.Protect (newpass)
End If
Next ws
End Sub

I keep getting an error that just says "400". I've never written an Excel
macro before, so I don't have a clue if I'm doing this correctly. I plan to
save the macro in one workbook and run it on all the others. Once I have the
above code set correctly, I'd also like to add a message that would appear if
one of the three original passwords didn't work. I'd like that message to
show me the sheet name on which the macro failed. Any help would be
appreciated. Thanks!
 
D

Dave Peterson

This worked ok for me:

Option Explicit
Sub TryUnprotect(wks As Worksheet, myPWD As String)
On Error Resume Next
wks.Unprotect Password:=myPWD
On Error GoTo 0
End Sub
Function IsProtected(wks As Worksheet) As Boolean
With wks
IsProtected = CBool(.ProtectContents _
Or .ProtectDrawingObjects _
Or .ProtectScenarios)
End With
End Function
Sub testme()
Dim wks As Worksheet
Dim myPWDs As Variant
Dim NewPWD As String
Dim pCtr As Long
Dim WksIsProtected As Boolean

myPWDs = Array("Pass1", "Pass2", "Pass3")
NewPWD = "NewPass"

For Each wks In ActiveWorkbook.Worksheets
WksIsProtected = True
If IsProtected(wks) = False Then
WksIsProtected = False
Else
For pCtr = LBound(myPWDs) To UBound(myPWDs)
Call TryUnprotect(wks, CStr(myPWDs(pCtr)))
If IsProtected(wks) = False Then
WksIsProtected = False
Exit For
End If
Next pCtr
End If
If WksIsProtected Then
MsgBox wks.Name & " is not unprotected!"
Else
wks.Protect Password:=NewPWD
End If
Next wks
End Sub

========
Ps. You may want to read JE McGimpsey's notes on protection:
http://mcgimpsey.com/excel/removepwords.html
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top