方法一:
| 本方法编写了几个函数来完成上述工作 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 |
|
方法二:
| 以下将上述几个函数写成了一个类模块,供大家参考: Option Compare Database '----------------------------------------------------- '类模块名 :clsWhere '建立方法 :VBE 界面 -> 菜单 -> 插入 -> 类模块 '作用 :根据界面输入,动态组织 SQL 语句的 Where 子句 '出处 :http://access911 '作者 :cg1 '----------------------------------------------------- '先定义几个枚举常量 Public Enum ValueTypeEnum vDate = 1 vString = 2 vNumber = 3 vYesOrNo = 4 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 If Len(CheckSQLWords(CStr(varValue))) <= 13 Then JoinWhere = " (format(" & strFieldName & ",""yyyy-mm-dd"")" & strOperator & " format(#" & CheckSQLWords(CStr(varValue)) & "#,""yyyy-mm-dd"")) and " Else JoinWhere = " (" & strFieldName & strOperator & " #" & CheckSQLWords(CStr(varValue)) & "#) and " End If Else strErrorDescription = strErrorDescription & "您" & IIf(strAlertName = "", "", "在“" & strAlertName & "”中") & "填写的“" & CStr(varValue) & "”不是有效的日期,请再次复核!" & vbCrLf End If End If Case 2 'string If IsNull(varValue) = False Then Select Case intOperator Case vEqual JoinWhere = " (" & strFieldName & strOperator & " '" & CheckSQLWords(CStr(varValue)) & "') and " Case vlike JoinWhere = " (" & strFieldName & strOperator & " '*" & CheckSQLWords(CStr(varValue)) & "*') and " Case Else JoinWhere = " (" & strFieldName & strOperator & " '*" & CheckSQLWords(CStr(varValue)) & "*') and " End Select 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 4 'boolean If IsNull(varValue) = False Then ' Debug.Print CStr(CBool(#1/1/2005#)) 'boolean 不需要检验 JoinWhere = " (" & strFieldName & strOperator & CheckSQLWords(CStr(CBool(varValue))) & ") and " 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) 2006年加了一个 ADP 版本的,适用 SQL SERVER 2000 Option Compare Database '----------------------------------------------------- '类模块名 :clsWhere '建立方法 :VBE 界面 -> 菜单 -> 插入 -> 类模块 '作用 :根据界面输入,动态组织 SQL 语句的 Where 子句 '出处 :http://access911 '作者 :cg1 '----------------------------------------------------- '先定义几个枚举常量 Public Enum ValueTypeEnum vDate = 1 vString = 2 vNumber = 3 vYesOrNo = 4 End Enum Public Enum OperatorEnum vLessThan = 0 vMoreThan = 1 vEqual = 2 vLike = 3 vLikeRight = 4 vLikeLeft = 5 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 Property Get ConditionWords() As String '用于判断最终结果是否有 WHERE 子句,因为有可能是不需要条件,查询出所有的结果集合 '这个结果用于表达式,所以没有 where 这几个字 Dim strOutput As String If strErrorDescription <> "" Then Debug.Print strErrorDescription ConditionWords = "" Exit Property End If If IsNull(strOutput) = True Then ConditionWords = "" Exit Property Else strOutput = strSQLWhere End If If Right(strOutput, 5) = " and " Then strOutput = Mid(strOutput, 1, Len(strOutput) - 5) End If ConditionWords = 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 = "") '说明: '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 4 strOperator = " Like " Case 5 strOperator = " Like " Case Else strOperator = " Like " End Select Select Case strValueType Case 1 'date If IsNull(varValue) = False Then If IsDate(varValue) = True Then If Len(CheckSQLWords(CStr(varValue))) >= 13 Then JoinWhere = " (convert(datetime," & strFieldName & ",120)" & strOperator & " convert(datetime,'" & CheckSQLWords(CStr(varValue)) & "',120)) and " Else JoinWhere = " (" & strFieldName & strOperator & " '" & CheckSQLWords(CStr(varValue)) & "') and " End If Else strErrorDescription = strErrorDescription & "您" & IIf(strAlertName = "", "", "在“" & strAlertName & "”中") & "填写的“" & CStr(varValue) & "”不是有效的日期,请再次复核!" & vbCrLf End If End If Case 2 'string If IsNull(varValue) = False Then Select Case intOperator Case vEqual JoinWhere = " (" & strFieldName & strOperator & " '" & CheckSQLWords(CStr(varValue)) & "') and " Case vLike JoinWhere = " (" & strFieldName & strOperator & " '%" & CheckSQLWords(CStr(varValue)) & "%') and " Case vLikeRight JoinWhere = " (" & strFieldName & strOperator & " '" & CheckSQLWords(CStr(varValue)) & "%') and " Case vLikeLeft JoinWhere = " (" & strFieldName & strOperator & " '%" & CheckSQLWords(CStr(varValue)) & "') and " Case vLessThan JoinWhere = " (" & strFieldName & strOperator & " '" & CheckSQLWords(CStr(varValue)) & "') and " Case vMoreThan JoinWhere = " (" & strFieldName & strOperator & " '" & CheckSQLWords(CStr(varValue)) & "') and " Case Else JoinWhere = " (" & strFieldName & strOperator & " '%" & CheckSQLWords(CStr(varValue)) & "%') and " End Select 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 4 'boolean If IsNull(varValue) = False Then ' Debug.Print CStr(CBool(#1/1/2005#)) 'boolean 不需要检验 JoinWhere = " (" & strFieldName & strOperator & CheckSQLWords(CStr(CBool(varValue))) & ") and " 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 |
本站文章旨在为该问题提供解决思路及关键性代码,并不能完成应该由网友自己完成的所有工作,请网友在仔细看文章并理解思路的基础上举一反三、灵活运用。
access911.net 原创文章,作者本人对文章保留一切权利。 如需转载必须征得作者同意并注明本站链接
|
|