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
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
'先定义几个枚举常量
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 = "")
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
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