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()
'Enable certain options on the main menu screen depending on access level
'If Me.txtPWD Like "SU*" Then
' Forms!frmMainMenu!optMaintenance.Enabled = False
'Else
' If Me.txtPWD Like "US*" Then
' Forms!frmMainMenu!optReports.Enabled = False
' Forms!frmMainMenu!optSuspCase.Enabled = False
' Forms!frmMainMenu!optMaintenance.Enabled = False
' End If
'End If
DoCmd.OpenForm "frmMainMenu"
Me.Visible = False
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
Private Sub txtPWD_AfterUpdate()
'Password validation
Dim db As DAO.Database
Dim rstUser As DAO.Recordset
Dim strUserNm As String
Dim intNum As Integer
'Set db = CurrentDb 'set db to PICTS DB
Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be")
Set rstUser = db.OpenRecordset("tblLOGIN")
strUserNm = txtUserNm
rstUser.Index = "USERNM"
rstUser.Seek "=", strUserNm
If rstUser!EncryptPWD = Me.txtPWD Then
'Enable certain options on the main menu screen depending on access levels
If Me.txtPWD = "SU900Sus" Then
DoCmd.OpenForm "frmMainMenu"
Forms!frmMainMenu!optMaintenance.Enabled = False
Forms!frmMainMenu!optMCO.Enabled = True
'DoCmd.Close acForm, "frmLogin"
Else
If Me.txtPWD Like "su503Eri" Then
DoCmd.OpenForm "frmMainMenu"
Forms!frmMainMenu!optMCO.Enabled = False
Forms!frmMainMenu!optComplaint.Enabled = True
Forms!frmMainMenu!optSuspCase.Enabled = False
Forms!frmMainMenu!optMaintenance.Enabled = False
Else
If Me.txtPWD Like "SU*" Then
DoCmd.OpenForm "frmMainMenu"
Forms!frmMainMenu!optReports.Enabled = True
Forms!frmMainMenu!optMaintenance.Enabled = False
Forms!frmMainMenu!optMCO.Enabled = False
Forms!frmMainMenu!optComplaint.Enabled = False
Else
If Me.txtPWD Like "us502Mic" Then
DoCmd.OpenForm "frmMainMenu"
Forms!frmMainMenu!optReports.Enabled = False
Forms!frmMainMenu!optComplaint.Enabled = True
Forms!frmMainMenu!optSuspCase.Enabled = False
Forms!frmMainMenu!optMaintenance.Enabled = False
Forms!frmMainMenu!optMCO.Enabled = False
Else
If Me.txtPWD Like "us501Tan" Then
DoCmd.OpenForm "frmMainMenu"
Forms!frmMainMenu!optReports.Enabled = False
Forms!frmMainMenu!optComplaint.Enabled = True
Forms!frmMainMenu!optSuspCase.Enabled = False
Forms!frmMainMenu!optMaintenance.Enabled = False
Forms!frmMainMenu!optMCO.Enabled = True
Else
If Me.txtPWD Like "us601Sur" Then
DoCmd.OpenForm "frmMainMenu"
Forms!frmMainMenu!optReports.Enabled = False
Forms!frmMainMenu!optComplaint.Enabled = True
Forms!frmMainMenu!optSuspCase.Enabled = False
Forms!frmMainMenu!optMaintenance.Enabled = False
Forms!frmMainMenu!optMCO.Enabled = False
'DoCmd.Close acForm, "frmLogin"
Else
If Me.txtPWD Like "US*" Then
DoCmd.OpenForm "frmMainMenu"
Forms!frmMainMenu!optReports.Enabled = False
Forms!frmMainMenu!optComplaint.Enabled = False
Forms!frmMainMenu!optMaintenance.Enabled = False
Forms!frmMainMenu!optMCO.Enabled = False
Else
If Me.txtPWD Like "AD*" Then
DoCmd.OpenForm "frmMainMenu"
'DoCmd.Close acForm, "frmLogin"
Else
If Me.txtPWD = "oig901ml" Then
DoCmd.OpenForm "frmMainMenu"
Forms!frmMainMenu!optMaintenance.Enabled = False
End If
End If
End If
End If
End If
End If
End If
End If
End If
Else
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
End If
End If
End Sub
Private Sub txtUserNm_AfterUpdate()
'User validation
Dim db As DAO.Database
Dim rstUser As DAO.Recordset
Dim strUserNm As String
'Set db = CurrentDb 'set db to PICTS DB
Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be")
Set rstUser = db.OpenRecordset("tblLOGIN")
strUserNm = Me.txtUserNm
gblUserNm = Me.txtUserNm
rstUser.Index = "USERNM"
rstUser.Seek "=", strUserNm
If rstUser.NoMatch = False Then
Me.txtPWD.Enabled = True
Me.txtPWD.SetFocus
Me.txtValidUser = "Y"
Else
MsgBox "No Match For User Name " & strUserNm, vbInformation + vbOKOnly, "INVALID USER NAME"
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.Close
Else
Me.txtUserNm = Null
Me.txtUserNm.SetFocus
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 strUser As String
Dim strStatus As String
Dim strSQL As String
Dim db As DAO.Database
Dim rstStatus As DAO.Recordset
Set db = OpenDatabase("S:\OIG PICTS DB\ADMIN\PICTS DB_be")
Set rstStatus = db.OpenRecordset("tblLOGIN")
strUser = Me.txtUserNm
rstStatus.Index = "USERNM"
rstStatus.Seek "=", strUser
If rstStatus!STATUS = "A" Then
strStatus = rstStatus!STATUS
Me.txtStatus = strStatus
End If
If Me.txtStatus = "A" Then
Me.txtPWD.Enabled = True
' Me.txtPWD.SetFocus
Me.txtValidUser = "Y"
Else
MsgBox "Invalid User Name Try Again" & vbCrLf & " GOOD-BYE", vbCritical + vbOKOnly, "TRY AGAIN LATER"
Me.txtValidUser = "N"
Me.txtPWD.Enabled = False
Me.cmdLOGIN.Enabled = False
DoCmd.Quit
End If
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 Sub