|
这里有个转换模糊查询语句的where字句的函数,有一定的通用性,不妨一试:
用前段时间发表的模糊查询例子中的那个函数改的。
Public Const conAND As Integer = 1
Public Const conOR As Integer = 2
'===============================================================================
'-函数名称: GetSQLWhere
'-功能描述: 将参数转换为模糊查询的SQL语句的Where子句
'-输入参数说明: 参数1: 可选 strField As String 字段名称
' 参数2: 可选 strKeyWords As String 查询关键字
' 参数3: 可选 intOperation As Integer 运算符(常量:conAND或者1,conOR或者2)
'-返回参数说明:
'-使用语法示例:
'-参考:
'-使用注意: 可使用中文的,;和英文的,和空格来作为关键的分隔符
'-兼容性: 2000,XP,2003
'-作者: fan0217@163.com
'-更新日期: 2006-06-20
'===============================================================================
Public Function GetSQLWhere(Optional strField As String, _
Optional strKeyWords As String = "", _
Optional intOperation As Integer = 1) As String
On Error GoTo Err_GetSQLWhere
Dim strSqlWhere As String, varKWArray As Variant
Dim intMax As Integer, i As Integer, strOperation As String
Dim strKW As String
If intOperation <> conAND And intOperation <> conOR Then
'MsgBox "intOperation参数设置不正确。", 16, "fan0217"
Exit Function
End If
If strKeyWords = "" Then
strSqlWhere = ""
Else
strKeyWords = Replace(strKeyWords, ";", " ") '将中文分号换成空格
strKeyWords = Replace(strKeyWords, ";", " ") '将英文分号换成空格
strKeyWords = Replace(strKeyWords, ",", " ") '将中文逗号换成空格
strKeyWords = Replace(strKeyWords, ",", " ") '将英文逗号换成空格
strKeyWords = Trim(strKeyWords) '去处首尾的空格
varKWArray = Split(strKeyWords) '将字符串根据空格拆开,获得一个数组
intMax = UBound(varKWArray) '获取数组的最大下标
If strKeyWords <> "" Then
If intMax = 0 Then
strSqlWhere = strSqlWhere & "([" & strField & "] Like '*" & varKWArray(0) & "*')"
Else
If intOperation = conAND Then
strOperation = " And "
ElseIf intOperation = conOR Then
strOperation = " Or "
End If
For i = 0 To intMax
strKW = Trim(varKWArray(i))
If i = 0 Then
strSqlWhere = strSqlWhere & "([" & strField & "] Like '*" & strKW & "*'" & strOperation
ElseIf i = intMax Then
strSqlWhere = strSqlWhere & "[" & strField & "] Like '*" & strKW & "*')"
Else
strSqlWhere = strSqlWhere & "[" & strField & "] Like '*" & strKW & "*'" & strOperation
End If
Next
End If
End If
End If
GetSQLWhere = strSqlWhere
Exit_GetSQLWhere:
Exit Function
Err_GetSQLWhere:
MsgBox Err.Description
Resume Exit_GetSQLWhere
End Function
|
|