机房收费系统之条件查询窗体

这种窗体的功能：对某个表进行限定条件的查询。

   
步骤：

1，转换字段名。窗体中的字段名是汉字，而我们数据表中的字段是英语单词，我在这里使用了数组来转换。（字段名的索引与我们数组的索引是相对应的）

Title(0) = "Cardno"           ’对于字段名的替换

Title(1) = "Name"

Title(2) = "OnDate"

Title(3) = "OnTime"

Title(4) = "Computername"

Compose(0) = " and "     ‘对于组合方式的替换

Compose(1) = " or "

所以我们的连接语句转换为了：

strSQL = strSQL & Compose(cboCompose1.ListIndex) & Trim(Title(cboFields2.ListIndex)) & Trim(cboOperator2.Text) & "'" & Trim(txtCheck2.Text) & "'"

2，这里最容易出错的地方就是日期的类型问题(因为日期型的数据对查询条件要求很严格，如果不是严格的日期格式就非常容易出错），在这里我是通过将日期（数据表中的日期字段）类型转换成了字符型）；当然还有另一种方法判断当字段名为日期时，判断查询内容的格式如果不是日期型就提示他输入正确的格式）。

3，当用户什么查询条件也没选择的时候就提示它选择字段，操作符和查询内容（至少有一条完整的查询条件)，还有个容易出错的地方就是连接字符串的时候注意空格的使用。

4，当语句有错误时，则进行错误处理。（直接提示错误，跳出；但若是在执行sql语句的过程中出现错误，则会先提示错误代码（模块中的错误处理），然后再进入该过程的错误处理）

该窗体代码：（其中的一部分）

'确定查询

Private Sub cmdOk_Click()

    Static strSQL As String

    Dim MsgString As String

    Dim mrs As ADODB.Recordset

    Dim Title(0 To 5) As String

    Dim Compose(0 To 1) As String

    Title(0) = "Cardno"

    Title(1) = "Name"

    Title(2) = "OnDate"

    Title(3) = "OnTime"

    Title(4) = "Computername"

    Compose(0) = " and "

    Compose(1) = " or "

    Call Clear

    On Error GoTo sub_error

    strSQL = "select * from OnKeys where "

    If (Trim(cboFields1.Text) <> "" And Trim(cboOperator1.Text) <> "" And Trim(txtCheck1.Text) <> "") Then

        bOk1 = True

    Else

        bOk1 = False

    End If

    If (Trim(cboFields2.Text) <> "" And Trim(cboOperator2.Text) <> "" And Trim(txtCheck2.Text) <> "") Then

        bOk2 = True

    Else

        bOk2 = False

    End If

    If (Trim(cboFields3.Text) <> "" And Trim(cboOperator3.Text) <> "" And Trim(txtCheck3.Text) <> "") Then

        bOk3 = True

    Else

        bOk3 = False

    End If

    '一行条件也没有

    If (bOk1 = False And bOk2 = False And bOk3 = False) Then

        If Trim(cboFields1.Text) = "" Then

            MsgBox "请输入字段！", vbExclamation + vbOKOnly, "警告"

            Exit Sub

        ElseIf Trim(cboOperator1.Text) = "" Then

            MsgBox "请输入运算符！", vbExclamation + vbOKOnly, "警告"

            Exit Sub

        ElseIf Trim(txtCheck1.Text) = "" Then

            MsgBox "请输入查询内容！", vbExclamation + vbOKOnly, "警告"

            Exit Sub

        End If

    End If

    '有第一行条件

    If (bOk1 = True) Then

            strSQL = strSQL & Trim(Title(cboFields1.ListIndex)) & Trim(cboOperator1.Text) & "'" & Trim(txtCheck1.Text) & "'"

    End If

    '有第二行条件

    If (bOk2 = True) Then

        If bOk1 = True Then

            If Trim(cboCompose1.Text) = "" Then

                MsgBox "请选择第一个组合关系！", vbExclamation + vbExclamation + vbOKOnly, "警告"

                cboCompose1.SetFocus

                Exit Sub

            Else

                strSQL = strSQL & Compose(cboCompose1.ListIndex) & Trim(Title(cboFields2.ListIndex)) & Trim(cboOperator2.Text) & "'" & Trim(txtCheck2.Text) & "'"

            End If

        Else

            strSQL = strSQL & Trim(Title(cboFields2.ListIndex)) & Trim(cboOperator2.Text) & "'" & Trim(txtCheck2.Text) & "'"

        End If

    End If

    '有第三行条件

    If (bOk3 = True) Then

        If (bOk2 = True) Then

            If bOk1 = True Then

                If Trim(cboCompose2.Text) = "" Then

                    MsgBox "请选择第二个组合关系！", vbExclamation + vbExclamation + vbOKOnly, "警告"

                    cboCompose2.SetFocus

                    Exit Sub

                Else

                    strSQL = strSQL & Compose(cboCompose2.ListIndex) & Trim(Title(cboFields3.ListIndex)) & Trim(cboOperator3.Text) & "'" & Trim(txtCheck3.Text) & "'"

                End If

            Else

                    strSQL = strSQL & Compose(cboCompose1.ListIndex) & Trim(Title(cboFields3.ListIndex)) & Trim(cboOperator3.Text) & "'" & Trim(txtCheck3.Text) & "'"

            End If

        Else

            If bOk1 = True Then

                If Trim(cboCompose1.Text) = "" Then

                    MsgBox "请选择第一个组合关系！", vbExclamation + vbExclamation + vbOKOnly, "警告"

                    cboCompose1.SetFocus

                    Exit Sub

                Else

                    strSQL = strSQL & Compose(cboCompose1.ListIndex) & Trim(Title(cboFields3.ListIndex)) & Trim(cboOperator3.Text) & "'" & Trim(txtCheck3.Text) & "'"

                End If

            Else

                    strSQL = strSQL & Trim(Title(cboFields3.ListIndex)) & Trim(cboOperator3.Text) & "'" & Trim(txtCheck3.Text) & "'"

            End If

        End If

    End If

    '当什么也没有选时

    If strSQL = "select * from OnKeys where " Then

        strSQL = "select * from OnKeys where State='上机状态'"

    Else

        strSQL = strSQL & " and State='上机状态'"

    End If

    Set mrs = ExecuteSQL(strSQL, MsgString)

    If mrs.EOF Then

        MsgBox "没有记录！", vbExclamation + vbOKOnly, "警告"

        With MyFlexGrid

            .Rows = 1

            .CellAlignment = 4  '单元内容居中对齐

            .TextMatrix(0, 0) = "卡号"

            .TextMatrix(0, 1) = "姓名"

            .TextMatrix(0, 2) = "上机日期"

            .TextMatrix(0, 3) = "上机时间"

            .TextMatrix(0, 4) = "机房名"

        End With

        Exit Sub

    End If

    With MyFlexGrid

        .Rows = 1

        .CellAlignment = 4  '单元内容居中对齐

        .TextMatrix(0, 0) = "卡号"

        .TextMatrix(0, 1) = "姓名"

        .TextMatrix(0, 2) = "上机日期"

        .TextMatrix(0, 3) = "上机时间"

        .TextMatrix(0, 4) = "机房名"

        Do While Not (mrs.EOF)

            .CellAlignment = 1

            .Rows = .Rows + 1

            .TextMatrix(.Rows - 1, 0) = Trim(mrs.Fields(0))

            .TextMatrix(.Rows - 1, 1) = Trim(mrs.Fields(1))

            .ColWidth(2) = 1600

            .TextMatrix(.Rows - 1, 2) = Trim(mrs.Fields(2))

            .TextMatrix(.Rows - 1, 3) = Trim(mrs.Fields(3))

            .TextMatrix(.Rows - 1, 4) = Trim(mrs.Fields(11))

            mrs.MoveNext

        Loop

    End With

    Exit Sub

sub_error:

    MsgBox "您的输入错误！", vbExclamation + vbOKOnly, "警告"

    Exit Sub

End Sub