逻辑很重要,慢慢缕。流程图与代码如下:
Private Sub cmdOk_Click() '用来存放SQL语句 '连接User表 Dim txtSQL As String '用来存放记录集对象 Dim mrc As ADODB.Recordset '用来存放返回信息 Dim MsgText As String '连接worklog Dim txtSQL2 As String '用来存放记录集对象 Dim mrc2 As ADODB.Recordset '用来存放返回信息 Dim MsgText2 As String '连接OnWork Dim txtSQL3 As String '用来存放记录集对象 Dim mrc3 As ADODB.Recordset '用来存放返回信息 Dim MsgText3 As String Username = "" '判断输入用户名是否为空 If Trim(txtUserName.Text = "") Then MsgBox "没有这个用户,请重新输入用户名!", 64, "温馨提示" txtUserName.Text = "" txtPassword.Text = "" txtUserName.SetFocus Else '查询指定用户名的记录 'txtSQL = "select * from user_Info where user_ID = '" & txtUserName.Text & "'" txtSQL = "select * from User_Info where userID = '" & txtUserName.Text & "'" '执行查询语句 Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF = True Then MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告" txtUserName.Text = "" txtPassword.Text = "" txtUserName.SetFocus Else '判断输入密码是否正确 If Trim(mrc.Fields(1)) = Trim(txtPassword.Text) Then If mrc.Fields(2) = "一般用户" Then '判断用户级别 frmMain.GeneraUser.Enabled = True frmMain.Operator.Enabled = False frmMain.Administrator.Enabled = False ok = True MsgBox "您的级别为一般用户,欢迎登陆", 64, "温馨提示" Me.Hide frmMain.Show Username = Trim(txtUserName.Text) End If If mrc.Fields(2) = "操作员" Then '判断用户级别 frmMain.GeneraUser.Enabled = True frmMain.Operator.Enabled = True frmMain.Administrator.Enabled = False ok = True MsgBox "您的级别为操作员,欢迎登陆", 64, "温馨提示" Me.Hide frmMain.Show Username = Trim(txtUserName.Text) End If If mrc.Fields(2) = "管理员" Then '判断用户级别 frmMain.GeneraUser.Enabled = True frmMain.Operator.Enabled = True frmMain.Administrator.Enabled = True ok = True MsgBox "您的级别为管理员,欢迎登陆", 64, "温馨提示" Me.Hide frmMain.Show Username = Trim(txtUserName.Text) End If '将登陆记录写入worklog表中 txtSQL2 = "select * from worklog_info" Set mrc2 = ExecuteSQL(txtSQL2, MsgText2) mrc2.AddNew mrc2.Fields(1) = mrc.Fields(0) 'UserID mrc2.Fields(2) = mrc.Fields(2) '级别 mrc2.Fields(3) = Date '上线日期 mrc2.Fields(4) = Time '上线时间 mrc2.Fields(7) = Trim(VBA.Environ("computername")) '电脑名称 mrc2.Fields(8) = True '判断正常下线 ' 将登录记录写入OnWork表中 txtSQL3 = "select * from OnWork_info" Set mrc3 = ExecuteSQL(txtSQL3, MsgText3) mrc3.AddNew mrc3.Fields(0) = mrc.Fields(0) 'UserID mrc3.Fields(1) = mrc.Fields(2) '级别 mrc3.Fields(2) = Date '上机时间 mrc3.Fields(3) = Time '下机时间 mrc3.Fields(4) = Trim(VBA.Environ("computername")) '电脑名称 mrc2.Update XX = mrc2.Fields(0) mrc2.Close mrc3.Update mrc3.Close mrc.Close Else MsgBox "输入密码不正确,请重新输入!", vbOKOnly + vbExclamation, "警告" txtPassword.SetFocus txtPassword.Text = "" End If End If End If '记载输入密码不正确 micount = micount + 1 If micount = 2 Then MsgBox "用户名或密码再错一次将会退出程序", 64, "温馨提示" End If If micount = 3 Then MsgBox "次数超出,即将退出", 64, "温馨提示" End End If End Sub