一个常用的组合多条件查询 WHERE 子句的函数_access模块-access类模块-access函数-access VBA

一个常用的组合多条件查询 WHERE 子句的函数

时间：2005-02-06 00:00 来源：Access911 作者：cg1『文章… 阅读：次

方法一：

本方法编写了几个函数来完成上述工作

Option Compare Database
'先定义几个枚举常量
Public Enum ValueTypeEnum
    vDate = 1
    vString = 2
    vNumber = 3
End Enum
Public Enum OperatorEnum
    vLessThan = 0
    vMorethan = 1
    vEqual = 2
    vLike = 3
End Enum

Function JoinWhere(ByVal strFieldName As String, _
                    ByVal varValue As Variant, _
                    Optional ByVal strValueType As ValueTypeEnum = 2, _
                    Optional ByVal intOperator As OperatorEnum = 3) As String


'作者           ：cg1
'说明：
'JoinWhere 函数专门用于组合常用的多条件搜索的Where子句
'参数说明：
'   strFieldName   ：用于传入需要查询的字段名
'   varValue       ：用于传入窗体上对应控件的值，可能是 NULL
'   strValueType   ：可选参数，用于指定数据类型，默认为 string
'   intOperator    ：可选参数，用于指定操作符类型，默认为 like

    Dim strOperateor As String
    Select Case intOperator
    Case 0
        strOperator = " <= "
    Case 1
        strOperator = " >= "
    Case 2
        strOperator = " = "
    Case 3
        strOperator = " Like "
    Case Else
        strOperator = " Like "
    End Select

    Select Case strValueType
    Case 1  'date
        If IsNull(varValue) = False Then
            If IsDate(varValue) = True Then
                JoinWhere = " (" & strFieldName & strOperator & " #" & CheckSQLWords(CStr(varValue)) & "#) and "
            Else
                MsgBox "“" & CStr(varValue) & "”不是有效的日期，请再次复核！", vbExclamation, "查询参数错误..."
            End If
        End If
    Case 2  'string
        If IsNull(varValue) = False Then
            JoinWhere = " (" & strFieldName & strOperator & " '*" & CheckSQLWords(CStr(varValue)) & "*') and "
        End If
    Case 3  'number
        If IsNull(varValue) = False Then
            If IsNumeric(varValue) Then
                JoinWhere = " (" & strFieldName & strOperator & CheckSQLWords(CStr(varValue)) & ") and "
            Else
                MsgBox "“" & CStr(varValue) & "”不是正确的数值，请再次复核！", vbExclamation, "查询参数错误..."
            End If
        End If
    Case Else
        JoinWhere = ""
    End Select
End Function
Public Function CheckSQLWords(ByVal strSQL As String) As String
'检查 SQL 字符串中是否包含非法字符
    If IsNull(strSQL) Then
        CheckSQLWords = ""
        Exit Function
    End If
    CheckSQLWords = Replace(strSQL, "'", "''")
End Function

Public Function CheckWhere(ByVal strSQLWhere As String) As String
'用于判断最终结果是否有 WHERE 子句，因为有可能是不需要条件，查询出所有的结果集合
    If IsNull(strSQLWhere) = True Then
        Exit Function
    End If
    If strSQLWhere <> "" Then
        strSQLWhere = " where " & strSQLWhere
    End If
    If Right(strSQLWhere, 5) = " and " Then
        strSQLWhere = Mid(strSQLWhere, 1, Len(strSQLWhere) - 5)
    End If
    CheckWhere = strSQLWhere
End Function

Function CheckSQLRight(ByVal strSQL As String) As Boolean
'用 EXECUTE 执行一遍来检测 SQL 是否有错误，只适用于耗时较少的 SELECT 查询
    On Error Resume Next
    CurrentProject.Connection.Execute strSQL
    If Err <> 0 Then
        Debug.Print Err.Number & " -> " & Err.Description
        CheckSQLRight = False
        Exit Function
    End If
    CheckSQLRight = True
End Function

实际使用时如下：

Private Sub Command12_Click()
    Dim strSQL As String
    Dim strWhere As String

    strSQL = "select * " & _
             "FROM tbl_user"

    '注意，查 FirstName 的时候并没有使用后面的两个参数，
    '因为那两个参数是默认值，默认为字符串按LIKE 查询
    strWhere = JoinWhere("id", Me.id, vNumber, vEqual) & _
                JoinWhere("FirstName", Me.FirstName) & _
                JoinWhere("createdate", Me.CreateDate1, vDate, vMorethan) & _
                JoinWhere("createdate", Me.CreateDate2, vDate, vLessThan) & _
                JoinWhere("worknumber", Me.WorkNumber1, vNumber, vMorethan) & _
                JoinWhere("worknumber", Me.WorkNumber2, vNumber, vLessThan)
    '你无需关心JoinWhere函数是如何编写出来的。你只要关心JoinWhere有4个
    '参数，该如何填写即可。记得组织完 WHERE 子句后用 CheckWhere 函数检查一遍。

    '以下用于判断最终结果是否有 WHERE 子句，因为有可能是不需要条件，查询出所有的结果集合
    strWhere = CheckWhere(strWhere)

    strSQL = strSQL & strWhere


    '以下部分用于检测 SQL 语句语法是否有错误，觉得没必要可以去掉
    If CheckSQLRight(strSQL) = False Then
        MsgBox "SQL 语句有错误，请查看“立即窗口”"
        Exit Sub
    End If

    Me.Sub_Frm_UserList.Form.RecordSource = strSQL
End Sub

方法二：

以下将上述几个函数写成了一个类模块，供大家参考：

Option Compare Database

'-----------------------------------------------------
'类模块名   ：clsWhere
'建立方法   ：VBE 界面 -> 菜单 -> 插入 -> 类模块
'作用       ：根据界面输入，动态组织 SQL 语句的 Where 子句
'作者       ：cg1
'-----------------------------------------------------

'先定义几个枚举常量
Public Enum ValueTypeEnum
    vDate = 1
    vString = 2
    vNumber = 3
End Enum
Public Enum OperatorEnum
    vLessThan = 0
    vMorethan = 1
    vEqual = 2
    vLike = 3
End Enum
Private strSQLWhere As String
Private strErrorDescription As String

Public Property Get ErrorDescription() As String
ErrorDescription = strErrorDescription
End Property

Public Property Get WhereWords() As String
'用于判断最终结果是否有 WHERE 子句，因为有可能是不需要条件，查询出所有的结果集合
    Dim strOutput As String

    If strErrorDescription <> "" Then
        Debug.Print strErrorDescription
        WhereWords = ""
        Exit Property
    End If
    If IsNull(strOutput) = True Then
        WhereWords = ""
        Exit Property
    Else
        strOutput = strSQLWhere
    End If

    If strOutput <> "" Then
        strOutput = " where " & strOutput
    End If
    If Right(strOutput, 5) = " and " Then
        strOutput = Mid(strOutput, 1, Len(strOutput) - 5)
    End If
    WhereWords = strOutput
End Property

Public Function JoinWhere(ByVal strFieldName As String, _
                    ByVal varValue As Variant, _
                    Optional ByVal strValueType As ValueTypeEnum = 2, _
                    Optional ByVal intOperator As OperatorEnum = 3, _
                    Optional ByVal strAlertName As String = "")

'出处           ：http://access911.net
'作者           ：cg1
'说明：
'JoinWhere 函数专门用于组合常用的多条件搜索的Where子句
'参数说明：
'   strFieldName   ：用于传入需要查询的字段名
'   varValue       ：用于传入窗体上对应控件的值，可能是 NULL
'   strValueType   ：可选参数，用于指定数据类型，默认为 string
'   intOperator    ：可选参数，用于指定操作符类型，默认为 like
'   strAlertName   ：可选参数，如果有错误，提示用户是哪个项目出错了，默认为 ""

    Dim strOperateor As String
    Select Case intOperator
    Case 0
        strOperator = " <= "
    Case 1
        strOperator = " >= "
    Case 2
        strOperator = " = "
    Case 3
        strOperator = " Like "
    Case Else
        strOperator = " Like "
    End Select

    Select Case strValueType
    Case 1  'date
        If IsNull(varValue) = False Then
            If IsDate(varValue) = True Then
                JoinWhere = " (" & strFieldName & strOperator & " #" & CheckSQLWords(CStr(varValue)) & "#) and "
            Else
                strErrorDescription = strErrorDescription & "您" & IIf(strAlertName = "", "", "在“" & strAlertName & "”中") & "填写的“" & CStr(varValue) & "”不是有效的日期，请再次复核！" & vbCrLf
            End If
        End If
    Case 2  'string
        If IsNull(varValue) = False Then
            JoinWhere = " (" & strFieldName & strOperator & " '*" & CheckSQLWords(CStr(varValue)) & "*') and "
        End If
    Case 3  'number
        If IsNull(varValue) = False Then
            If IsNumeric(varValue) Then
                JoinWhere = " (" & strFieldName & strOperator & CheckSQLWords(CStr(varValue)) & ") and "
            Else
                strErrorDescription = strErrorDescription & "您" & IIf(strAlertName = "", "", "在“" & strAlertName & "”中") & "填写的“" & CStr(varValue) & "”不是正确的数值，请再次复核！" & vbCrLf
            End If
        End If
    Case Else
        JoinWhere = ""
    End Select

    strSQLWhere = strSQLWhere & JoinWhere

End Function

Private Function CheckSQLWords(ByVal strSQL As String) As String
'检查 SQL 字符串中是否包含非法字符
    If IsNull(strSQL) Then
        CheckSQLWords = ""
        Exit Function
    End If
    CheckSQLWords = Replace(strSQL, "'", "''")
End Function

Public Function CheckSQLRight(ByVal strSQL As String) As Boolean
'用 EXECUTE 执行一遍来检测 SQL 是否有错误，只适用于耗时较少的 SELECT 查询
    On Error Resume Next
    CurrentProject.Connection.Execute strSQL
    If Err <> 0 Then
        Debug.Print Err.Number & " -> " & Err.Description
        CheckSQLRight = False
        Exit Function
    End If
    CheckSQLRight = True
End Function

调用时代码如下：

Private Sub Command12_Click()
    Dim strSQL As String
    Dim c As New clsWhere

    strSQL = "select * " & _
             "FROM tbl_user"

    '注意，查 FirstName 的时候并没有使用后面的两个参数，
    '因为那两个参数是默认值，默认为字符串按LIKE 查询。
    '注意，参数“strAlertName”并不一定要等于参数“varValue”的控件名

    With c
        .JoinWhere "id", Me.id, vNumber, vEqual, "id"
        .JoinWhere "FirstName", Me.FirstName, , , "FirstName"
        .JoinWhere "createdate", Me.CreateDate1, vDate, vMorethan, "From CreateDate"
        .JoinWhere "createdate", Me.CreateDate2, vDate, vLessThan, "To CreateDate"
        .JoinWhere "worknumber", Me.WorkNumber1, vNumber, vMorethan, "From WorkNumber"
        .JoinWhere "worknumber", Me.WorkNumber2, vNumber, vLessThan, "To WorkNumber"
    End With

    If c.ErrorDescription = "" Then
        Debug.Print c.WhereWords
        '以下部分用于检测 SQL 语句语法是否有错误，觉得没必要可以去掉
        'If c.CheckSQLRight(strSQL) = False Then
        '    MsgBox "SQL 语句有错误，请查看“立即窗口”"
        '    Exit Sub
        'End If
        Me.Sub_Frm_UserList.Form.RecordSource = strSQL & c.WhereWords
    Else
        MsgBox c.ErrorDescription, vbExclamation
        Exit Sub
    End If
    Set c = Nothing
End Sub

示例下载：
http://access911.net/down/eg/eg_query_property.rar (35KB)

(责任编辑：admin)

顶一下

(2)

100%

踩一下

(0)

上一篇：把日期转化为中文表示格式
下一篇：如何在自定义函数中实现枚举值