With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.
Option Compare Database Const NumLoginAttempts = 3 Dim Attempts As Integer Private Sub Cbousername_AfterUpdate() 'If a username is selected, then place the focus on the password field. If Not IsNull(Me.Cbousername) Then Me.txtPwd.SetFocus Me.CmdLogin.Enabled = True End If End Sub Private Sub CmdLogin_Click() 'Check to make sure that there are characters in the txtpwd field 'If not, display message telling user that a password must be entered and place focus back on the password box If IsNull(Me.txtPwd) Then MsgBox "You must enter a password.", vbExclamation + vbOnly, "Required Entry" Me.txtPwd.SetFocus End If 'Validate password for user If Me.txtPwd.Value = DLookup("Password", "Users", "[ID]=" & Me.Cbousername.Value) Then ID = Me.Cbousername.Value 'Close the login form and open frmMain DoCmd.Close acForm, "FrmLogin", acSaveNo DoCmd.OpenForm "frmMain" End If If Me.txtPwd.Value <> DLookup("Password", "Users", "[ID]=" & Me.Cbousername.Value) Then MsgBox "The password you entered does not match the username selected.", vbExclamation + vbOnly, "Try Again" Me.txtPwd = "" Me.txtPwd.SetFocus Attempts = Attempts + 1 'After 3 tries, the db will close If Attempts > 3 Then MsgBox "Maximum number of attempts reached. Please contact administrator to reset your password.", vbExclamation + vbOKOnly, "Database Shutdown" DoCmd.CloseDatabase Exit Sub Else 'Compare txtpwd field value to the assignedpassword value for the user that is logging in 'If the password that the user types in matches the assignedpassword in tblusers, then have the user create a new password If Me.txtPwd.Value = DLookup("AssignedPassword", "Users", "[ID]=" & Me.Cbousername & " Or [Password] Is null") Then MsgBox "You must enter a new password.", vbExclamation + vbOKOnly, "Invalid Password" Me.LblPwd.Visible = False Me.txtPwd.Visible = False Me.LblNewPwd.Visible = True Me.TxtNewPwd.Visible = True Me.TxtNewPwd.SetFocus End If End If End If End Sub