Greetings,
We’ve a login form that was created by former employee. After noticing that one can access the DB by simply clicking login button (without entering username and password), I made some modification to prompt users enter username and password to access the DB, which seems to work partially. I’ve attached a document to show the test result and the area I still need to modify.
Below is part of the code used:
Can you please assist?
TIA
Regards,
OCM
We’ve a login form that was created by former employee. After noticing that one can access the DB by simply clicking login button (without entering username and password), I made some modification to prompt users enter username and password to access the DB, which seems to work partially. I’ve attached a document to show the test result and the area I still need to modify.
Below is part of the code used:
Code:
Option Compare Database
Public gblUserNm As String
Private Sub cmdClose_Click()
'Close The Login and Close Database Once Cancel It Clicked
On Error GoTo err_cmdClose_Click
DoCmd.Quit
Exit_cmdClose_Click:
Exit Sub
err_cmdClose_Click:
MsgBox Err.Description
Resume Exit_cmdClose_Click
End Sub
Private Sub cmdLOGIN_Click()
'Check to see if data is entered into the UserName combo box
If IsNull(Me.txtUserNm) Or Me.txtUserNm = "" Then
MsgBox "You must enter a User Name.", vbOKOnly, "Required Data"
Me.txtUserNm.SetFocus
Exit Sub
End If
'Check to see if data is entered into the password box
If IsNull(Me.txtPWD) Or Me.txtPWD = "" Then
MsgBox "You must enter a Password.", vbOKOnly, "Required Data"
Me.txtPWD.SetFocus
Exit Sub
End If
End Sub
Private Sub Form_Open(Cancel As Integer)
'Once Form Is Open Enable Everything and Set Focus To User Name Field
Application.SetOption "Confirm Action Queries", False
Me.txtAttempts = 0
Me.txtUserNm.SetFocus
End Sub
MsgBox "Password Is Invalid - Try Again!", vbCritical + vbOKOnly, "INVALID PASSWORD"
Me.txtInvalidPW = "Y"
Me.txtAttempts = Me.txtAttempts + 1
If Me.txtAttempts = 3 Then
MsgBox "Check Password And Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY
AGAIN LATER"
DoCmd.Quit
Else
Me.txtPWD.SetFocus
Me.cmdLOGIN.Enabled = False
' Me.cmdLOGIN.Enabled = True
End If
End If
End Sub
Private Sub txtUserNm_BeforeUpdate(Cancel As Integer)
'Check To See If User Are Valid. Look Into The Table To Get User Status
Dim strStatus As String
Dim strSQL As String
Dim db As DAO.Database
Dim rstStatus As DAO.Recordset
Set db = OpenDatabase("location of DB")
Set rstStatus = db.OpenRecordset("tblLOGIN", dbOpenTable)
rstStatus.Index = "USERNM"
rstStatus.Seek "=", Me.txtUserNm
If rstStatus.NoMatch Then '*** User Name not found! ***
MsgBox " Invalid User Name - Try Again!", vbCritical + vbOKOnly, "INVALID USER NAME"
Me.txtValidUser = "N"
Me.txtAttempts = Me.txtAttempts + 1
If Me.txtAttempts = 3 Then
MsgBox "Check User Name And Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER"
DoCmd.Quit
Else
' Me.cmdLOGIN.Enabled = False
Me.cmdLOGIN.Enabled = True
End If
End If
rstStatus.Close '*** Clean Up ***
End Sub
Private Sub txtUserNm_GotFocus()
'Check Users Information If Valid Then Set Focus To Password Otherwise Close
If Me.txtValidUser = "Y" And Me.txtInvalidPW = "Y" Then
Me.txtPWD.SetFocus
End If
End SubTIA
Regards,
OCM
