上机是机房收费系统中非常重要的一个功能,也是最先需要实现的功能呢,以上是上机的流程图
Private Sub cmdOnLine_Click() Dim startime As String Dim mrc As ADODB.Recordset '连接student表中的 Dim txtSQL As String Dim MsgText As String Dim mrc1 As ADODB.Recordset '连接online表中的 Dim mrc2 As ADODB.Recordset '连接line表中的 '检查卡号是否存在 txtSQL = "select * from student_Info where cardno= '" & txtCardNo.Text & "'" Set mrc = ExecuteSQL(txtSQL, MsgText) If mrc.EOF Then MsgBox "没有这个卡号,请重新输入!", vbOKOnly + vbExclamation, "警告" txtCardNo.Text = "" mrc.Close txtCardNo.SetFocus Else If Trim(mrc.Fields(10)) = "不使用" Then MsgBox "没有此卡号" Else If Trim(Val(mrc.Fields(7))) <= 0 Then MsgBox "余额不足,请充值" txtCardNo.Text = "" txtName.Text = "" txtSex.Text = "" txtSID.Text = "" txtDept.Text = "" txtType.Text = "" txtOffDate.Text = "" txtOnTime.Text = "" txtOnDate.Text = "" txtOffTime.Text = "" txtCTime.Text = "" txtCMoney.Text = "" Else '点击上机,下机时间和日期,消费时间和金额文本框中数据清空 txtOnDate.Text = "" txtOnTime.Text = "" txtCTime.Text = "" txtCMoney.Text = "" '检查上机是否重复 txtSQL = "select * from Online_Info where cardno = '" & txtCardNo.Text & "'" Set mrc1 = ExecuteSQL(txtSQL, MsgText) If mrc1.EOF Then '从student表中向各个文本框中添加上机的数据 mrc.Update txtSID.Text = mrc.Fields(1) txtName.Text = mrc.Fields(2) txtSex.Text = mrc.Fields(3) txtDept.Text = mrc.Fields(4) txtBalance.Text = mrc.Fields(7) txtType.Text = mrc.Fields(14) mrc.Close '如果没有查到数据,那么创建一个新行,添加各个数据 mrc1.AddNew mrc1.Fields(0) = Trim(txtCardNo.Text) mrc1.Fields(1) = Trim(txtType.Text) mrc1.Fields(2) = Trim(txtSID.Text) mrc1.Fields(3) = Trim(txtName.Text) mrc1.Fields(4) = Trim(txtDept.Text) mrc1.Fields(5) = Trim(txtSex.Text) mrc1.Fields(6) = Date mrc1.Fields(7) = Time mrc1.Fields(8) = VBA.Environ("computername") startime = Now '获得系统时间 txtOnDate.Text = Format(startime, "yyyy/mm/dd") txtOnTime.Text = Format(startime, "hh:mm:ss") '使用格式函数显示格式 mrc1.Update '刷新line表中的数据 txtSQL = "select * from Line_Info where cardno = '" & txtCardNo.Text & "'" Set mrc2 = ExecuteSQL(txtSQL, MsgText) mrc2.AddNew mrc2.Fields(1) = Trim(txtCardNo.Text) mrc2.Fields(13) = "正常下机" mrc2.Fields(2) = Trim(txtSID.Text) mrc2.Fields(3) = Trim(txtName.Text) mrc2.Fields(4) = Trim(txtDept.Text) mrc2.Fields(5) = Trim(txtSex.Text) mrc2.Fields(6) = Date mrc2.Fields(7) = Time mrc2.Fields(14) = VBA.Environ("computername") mrc2.Update MsgBox "上机成功", vbOKOnly + vbExclamation, "登录成功" Else MsgBox "此用户正在上机" End If End If End If End If End Sub
以上是代码部分,供大家参考