Problem with password security

[Tanya]

Hi,
I have the following code, thanks to this forum and some very helpful people
and I have just noticed that when I run the by way of the first code below
and select cancel, I am taken to the admin sheet which is what I would like
to avoid. What code to I need to add so that if cancel is selected I am not
taken to Admin Sheet?


Private Sub CommandButton1_Click()
'Unprotect workbook
UnProtect_Workbook
'Show Admin Sheet
Sheets("Admin").Visible = True
Sheets("Admin").Select
End Sub

Sub UnProtect_Workbook()
'Unprotect workbook
Dim ws As Worksheet
Dim myPwd As String
Application.ScreenUpdating = False
Set ws = Worksheets(1)
On Error Resume Next
Do
myPwd = GetPassword
ws.Unprotect Password:=myPwd
If myPwd <> "" Then

If ws.ProtectContents Then

MsgBox "Invalid password, try again", vbOKOnly +
vbInformation, "Password input"
End If
End If
Loop Until Not ws.ProtectContents Or myPwd = ""
On Error GoTo 0
If myPwd <> "" Then

For Each ws In ActiveWorkbook.Worksheets

If ws.ProtectContents = True Then

ws.Unprotect Password:=myPwd
End If
Next ws
ActiveWorkbook.Unprotect Password:=myPwd
Application.ScreenUpdating = True
End If
End Sub

Private Function GetPassword() As Variant
GetPassword = InputBox(Prompt:="Please enter correct Password")
End Function

Thanks in advance

Cheers
Tanya

 

[Smallweed]

I imagine it's the GetPassword routine that's giving you the input box at
which you can click Cancel. Input boxes return an empty string ("") if you
click cancel so why not hide the Admin sheet again if this is returned:

Private Function GetPassword() As Variant
GetPassword = InputBox(Prompt:="Please enter correct Password")
If GetPassword="" Then
Sheets("Admin").Visible = False
End If
End Function

This leaves the problem of what happens with the rest of the
Unprotect_Workbook routine. You could do the following

....
....
Do
myPwd = GetPassword
If myPwd = "" Then Exit Sub
ws.Unprotect Password:=myPwd
....
....

 

[Nayab]

I imagine it's the GetPassword routine that's giving you the input box at
which you can click Cancel.  Input boxes return an empty string ("") if you
click cancel so why not hide the Admin sheet again if this is returned:

Private Function GetPassword() As Variant
GetPassword = InputBox(Prompt:="Please enter correct Password")
If GetPassword="" Then
Sheets("Admin").Visible = False
End If
End Function

This leaves the problem of what happens with the rest of the
Unprotect_Workbook routine.  You could do the following

...
...
 Do
myPwd = GetPassword
If myPwd = "" Then Exit Sub
ws.Unprotect Password:=myPwd
...
...

ya, the handling of the value returned by GetPassword needs to be
done. My concern will be if the password is "" and OK is pressed
instead of CANCEL, how will we be able to distinguish the two events?

 

[Smallweed]

Better than InputBox is Application.InputBox (i.e. Excel's own input box
rather than VBA's)

For example:
Application.InputBox("type password", , , , , , , 2)
(which is expecting text) returns "" if you click OK having left it blank
and False if you click Cancel.

 

[Harald Staff]

My concern will be if the password is "" and OK is pressed
instead of CANCEL, how will we be able to distinguish the two events?

Sub test2()
Dim S As String
S = InputBox("Talk:")
If StrPtr(S) = 0 Then
MsgBox "Cancelled"
Else
MsgBox "You said """ & S & """"
End If
End Sub

HTH. Best wishes Harald

 

[Nayab]

Sub test2()
Dim S As String
S = InputBox("Talk:")
If StrPtr(S) = 0 Then
    MsgBox "Cancelled"
Else
    MsgBox "You said """ & S & """"
End If
End Sub

HTH. Best wishes Harald

Thanks. This is really helpful.

 

[Tanya]

Thank you Smallweed

I am a lot closer, thanks to you. However I now have the problem that the
Admin sheet is not selected on the success of the password.

Do I need to add an Esleif to the Private function GetPassword? I have also
put a note in the middle of the code, and would appreciate your explaining
the event.

Here is the new code

Sub UnProtect_Workbook()
'Unprotect workbook
Dim ws As Worksheet
Dim myPwd As String
Application.ScreenUpdating = False
Set ws = Worksheets(1)
On Error Resume Next
Do
myPwd = GetPassword
If myPwd = "" Then Exit Sub
ws.Unprotect Password:=myPwd
If myPwd <> "" Then

If ws.ProtectContents Then

MsgBox "Invalid password, try again", vbOKOnly +
vbInformation, "Password input"
End If
End If
Loop Until Not ws.ProtectContents Or myPwd = ""
On Error GoTo 0
If myPwd <> "" Then 'Does this not refer to the option where no
password is input?

For Each ws In ActiveWorkbook.Worksheets

If ws.ProtectContents = True Then

ws.Unprotect Password:=myPwd
End If
Next ws
ActiveWorkbook.Unprotect Password:=myPwd
Application.ScreenUpdating = True
End If
End Sub

Private Function GetPassword() As Variant
GetPassword = Application.InputBox(Prompt:="Please enter correct Password")
If GetPassword = myPwd Then
Sheets("Admin").Visible = True

End If
End Function


Kind Regards
Tanya

 

[Smallweed]

Hi Tanya

It seems to have got over-complicated! Try the following - I've made
Unprotect_Workbook into a function that returns a True or False depending on
whether it's worked or whether the user has clicked Cancel. I've also got
rid of the GetPassword function:

Private Sub CommandButton1_Click()
'Unprotect workbook
If UnProtect_Workbook() Then
'Show Admin Sheet
Sheets("Admin").Visible = True
Sheets("Admin").Select
End If
End Sub

Function UnProtect_Workbook() As Boolean
'Unprotect workbook
Dim ws As Worksheet
Dim myPwd As String
Application.ScreenUpdating = False
Set ws = Worksheets(1)
On Error Resume Next
Do
myPwd = Application.InputBox("Please enter correct password")
If myPwd Then 'OK clicked
ws.Unprotect Password:=myPwd
If ws.ProtectContents Then
MsgBox "Invalid password, try again", vbOKOnly +
vbInformation, "Password input"
End If
Else 'Cancel clicked
Exit Function 'UnProtect_Workbook still set to False as this is
default
End If
Loop Until Not ws.ProtectContents
On Error GoTo 0
For Each ws In ActiveWorkbook.Worksheets
If ws.ProtectContents = True Then
ws.Unprotect Password:=myPwd
End If
Next ws
ActiveWorkbook.Unprotect Password:=myPwd
Application.ScreenUpdating = True
UnProtect_Workbook = True
End Function

 

[Tanya]

Thank you very very much. I am particularly grateful for your comments
throughout the code.

Kind Regards
Tanya