机房收费系统中,多次用到组合查询,经过上网查资料、请教同学、类比学生信息管理系统,我终于能够实现这个功能了,尽管还存在很多漏洞。下面分享一下代码,希望大家多多指教。
界面展示:
代码展示:
Option Explicit
Dim Index As Integer
'自定义查空事件
Private Sub checktext(Index As Integer)
If Not Testtxt(cboField(Index).Text) Then
MsgBox "请选择字段名", vbOKOnly + vbInformation, "温馨提示"
cboField(Index).SetFocus
Exit Sub
End If
If Not Testtxt(cboSign(Index).Text) Then
MsgBox "请选择操作符", vbOKOnly + vbInformation, "温馨提示"
cboSign(Index).SetFocus
Exit Sub
End If
If Not Testtxt(txtInput(Index).Text) Then
MsgBox "请输入要查询的内容", vbOKOnly + vbInformation, "温馨提示"
txtInput(Index).SetFocus
Exit Sub
End If
End Sub
Private Sub cmdCheck_Click()
Dim fields(0 To 4) As String
Dim relation(0 To 1) As String
Dim mrc As ADODB.Recordset
Dim txtsql As String
Dim msgtext As String
Dim dd(3) As Boolean
'定义变量,将不同的选择转化为表中的字段名送到变量中
fields(0) = "cardno"
fields(1) = "studentname"
fields(2) = "ondate"
fields(3) = "ontime"
fields(4) = "computer"
relation(0) = " and "
relation(1) = " or "
On Error Resume Next
'若配套的字段名+操作符+输入内容(+关系)均不为空,则用dd=true标记
If Trim(cboField(0).Text) <> "" And Trim(cboSign(0).Text) <> "" And Trim(txtInput(0).Text) <> "" Then
dd(1) = True
Else
dd(1) = False
End If
If Trim(cboField(1).Text) <> "" And Trim(cboSign(1).Text) <> "" And Trim(txtInput(1).Text) <> "" And cboRelation(0).Text <> "" Then
dd(2) = True
Else
dd(2) = False
End If
If Trim(cboField(2).Text) <> "" And Trim(cboSign(2).Text) <> "" And Trim(txtInput(2).Text) <> "" And cboRelation(1).Text <> "" Then
dd(3) = True
Else
dd(3) = False
End If
txtsql = "select * from online_info where "
'处理情况
If dd(1) = True Then
If dd(2) = True Then
If dd(3) = True Then '第一种情况,三个条件都输入
txtsql = txtsql & Trim(fields(cboField(0).ListIndex)) & Trim(cboSign(0).Text) & "'" & Trim(txtInput(0).Text) & "'" _
& (relation(cboRelation(0).ListIndex)) & Trim(fields(cboField(1).ListIndex)) & Trim(cboSign(1).Text) & "'" & Trim(txtInput(1).Text) & "'" _
& relation(cboRelation(1).ListIndex) & Trim(fields(cboField(2).ListIndex)) & Trim(cboSign(2).Text) & "'" & Trim(txtInput(2).Text) & "'"
Else '第一行和第二行输入
txtsql = txtsql & Trim(fields(cboField(0).ListIndex)) & Trim(cboSign(0).Text) & "'" & Trim(txtInput(0).Text) & "'" _
& relation(cboRelation(0).ListIndex) & Trim(fields(cboField(1).ListIndex)) & Trim(cboSign(1).Text) & "'" & Trim(txtInput(1).Text) & "'"
End If
Else '只有第一行的条件输入
txtsql = txtsql & Trim(fields(cboField(0).ListIndex)) & Trim(cboSign(0).Text) & "'" & Trim(txtInput(0).Text) & "'"
End If
Else '没有输入完整的条件,查空
Call checktext(0)
Exit Sub
End If
Set mrc = ExecuteSQL(txtsql, msgtext)
'查询结果处理
If mrc.EOF Then
MsgBox "没有找到符合要求的结果!", vbOKOnly + vbInformation, "温馨提示"
With MSHFlexGrid1
.Rows = 1
.CellAlignment = 4
.TextMatrix(0, 0) = "卡号"
.TextMatrix(0, 1) = "姓名"
.TextMatrix(0, 2) = "上机日期"
.TextMatrix(0, 3) = "上机时间"
.TextMatrix(0, 4) = "机房号"
End With
Exit Sub
Else
With MSHFlexGrid1
.Rows = 1
.CellAlignment = 4
.TextMatrix(0, 0) = "卡号"
.TextMatrix(0, 1) = "姓名"
.TextMatrix(0, 2) = "上机日期"
.TextMatrix(0, 3) = "上机时间"
.TextMatrix(0, 4) = "机房号"
Do While Not mrc.EOF
.Rows = .Rows + 1
.TextMatrix(.Rows - 1, 0) = mrc.fields("cardno")
.TextMatrix(.Rows - 1, 1) = mrc.fields("studentname")
.TextMatrix(.Rows - 1, 2) = mrc.fields("ondate")
.TextMatrix(.Rows - 1, 3) = mrc.fields("ontime")
.TextMatrix(.Rows - 1, 4) = mrc.fields("computer")
mrc.MoveNext
Loop
End With
mrc.Close
End If
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub