Help needed with password script

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,
I had the following code (found from this discussion group) to allow only
password holders to access the form. But after the password-protected form is
opened, the previous form still remains open. Could someone please show me
the code that could be atttached to the following code to close the previous
form IF correct password is entered? Any help is much appreciated.


Private Sub Form_Open(Cancel As Integer)
Const strFormPassword As String = "password"

If InputBox("Please enter password") <> strFormPassword Then
MsgBox "Password incorrect. Please try again", vbOKOnly
Cancel = True
End If

End Sub
 
Hi Sam,

Change your code to this:

Private Sub Form_Open(Cancel As Integer)
On Error GoTo ErrorPoint

Const strFormPassword As String = "password"

If InputBox("Please enter password for access to this form.", _
"Please Enter Password") <> strFormPassword Then
' Incorrect password entered
' Do not open the form
MsgBox "The password you have entered is incorrect." & _
vbNewLine & "Please try again or see the Database Administrator.", _
vbExclamation, "Access Denied"
Cancel = True
Else
' Correct password entered
' Now close the opening form
DoCmd.Close acForm, "NameOfMyFormHere"
End If

ExitPoint:
Exit Sub

ErrorPoint:
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint

End Sub

Enter the correct 'calling' form name in the apporpriate place to close it.
(A few artistic enhancements were made. Remove if desired)

On the form that opens the password protected form you should trap for and ignore Error 2501 when a
wrong password is entered. So a command button on the 'calling' form would be something like so:

Private Sub cmdOpenForm_Click()
On Error GoTo ErrorPoint

DoCmd.OpenForm "frmPassword"

ExitPoint:
Exit Sub

ErrorPoint:
If Err.Number <> 2501 Then
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
End If
Resume ExitPoint

End Sub
 
Back
Top