2008-05-11 22:41 | 只看楼主
树型| 收藏| 小 中 大 1

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

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
                   
'出处          ：http://access911.net
'作者          ：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
华纬教育网www.hwjy.net.cn提供IT、外语学习、管理咨询类社区