? BuildCriteria("[field]", dbInteger, "108") ' [field]=108
? BuildCriteria("[field]", dbInteger, ">12 and <=20") ' [field]>12 And ‹field›<=20
? BuildCriteria("[field]", dbInteger, "between 1 and 10") ' [field] Between 1 And 10
? BuildCriteria("[field]", dbInteger, "in (2,3,5,7,9)") ' [field] In (2,3,5,7,9)
These four examples are promissing. However, when the input cannot be evaluated, the function either produces an error message, or reverts to a text predicate.
? BuildCriteria("[field]", dbInteger, "><12") ' ** invalid syntax **
? BuildCriteria("[field]", dbInteger, "in (1,2,3") ' ** missing parenthesis **
? BuildCriteria("[field]", dbInteger, "from 1 to 10") ' [field]="from 1 to 10"
? BuildCriteria("[field]", dbInteger, "betwen 1 and 2") ' [field]="betwen 1" And [field]=2
? BuildCriteria("[field]", dbInteger, "!=108") ' "!"=108
When the criteria reverts to text, this will cause an error when we apply the filter, so we can catch the error later. But the last line is troublesome. The predicate is a valid SQL expression that will simply be evaluated to False. No error, but no records either.
? BuildCriteria("[field]", dbText, "A*") ' [field] Like "A*"
? BuildCriteria("[field]", dbText, "like Gen[èe]v[ea]") ' [field] Like "Gen[èe]v[ea]"
? BuildCriteria("[field]", dbText, "between A and M and not K") ' [field] Between "A" And "M" And Not [field]="K"
? BuildCriteria("[field]", dbText, "NY or LA") ' [field]="NY" Or [field]="LA"
? BuildCriteria("[field]", dbText, "who, me?") ' ** syntax error **
? BuildCriteria("[field]", dbText, "rock and roll") ' [field]="rock" And [field]="roll"
? BuildCriteria("[field]", dbText, "B&W") ' [field]="B" & "W"
Again, the last two examples will fail (in that no records will match) without throwing an error. This problem needs to be addressed.
? BuildCriteria("[field]", dbDate, "1 aug") ' [field]=#8/1/2011#
? BuildCriteria("[field]", dbDate, "> april 2000") ' [field]>#4/1/2000#
? BuildCriteria("[field]", dbDate, "between 1 jan and 31 dec") ' [field] Between #1/1/2011# And #12/31/2011#
? BuildCriteria("[field]", dbDate, "02/29") ' [field]=#2/1/2029#
The results shown in the comments are those expected using US regional settings. On the machine I'm writing this, they all fail (I would have to use French month names). The last is interpreted as meaning the 1st of February 2029, which is wrong on many levels. As a matter of fact, at least one of the previous examples might already have failed on some machines, but more about that later.
Function ValidBC( _
ByVal Field As String, _
ByVal FieldType As Integer, _
TextBox As TextBox, _
Domain As String _
) As Boolean
'
' Validates user input as criteria for a field.
' Calls BuildCriteria() to obtain error messages or a valid predicate,
' which is tested against the domain.
' On success, the predicate is translated back to the application language,
' respecting the user's decimal and list separators.
'
Static qdf As QueryDef
Dim strCrit As String
Dim strExpr As String
On Error GoTo Failure
If IsNull(TextBox) Then
gvarFeedbackValidBC = Null
ValidBC = True
Exit Function
End If
' add square brackets if missing and try
If InStr(Field, "[") = 0 Then Field = "[" & Field & "]"
strCrit = BuildCriteria(Field, FieldType, TextBox.Value)
' the syntax is correct, but does it work as criteria?
If qdf Is Nothing Then _
Set qdf = CurrentDb.CreateQueryDef("", "SELECT 1;")
qdf.SQL = "SELECT 1 FROM " & Domain & " WHERE " & strCrit
qdf.OpenRecordset
' BUILDING FEEDBACK
' recalc criteria with Tab as field name, and clean it out
strExpr = BuildCriteria(Chr(vbKeyTab), FieldType, TextBox.Value)
strExpr = Replace(strExpr, Chr(vbKeyTab) & "=", "")
strExpr = Replace(strExpr, Chr(vbKeyTab) & " ", "")
strExpr = Replace(strExpr, Chr(vbKeyTab), "")
' call localization function
strExpr = Localize(strExpr)
' use one of two sanity checks:
' raise error if expression no longer yields the same predicate
If strCrit <> BuildCriteria(Field, FieldType, strExpr) Then _
Err.Raise 2431, "Validate", "Invalid syntax."
' or just assert as design time
Debug.Assert strCrit = BuildCriteria(Field, FieldType, strExpr)
' store feedback in global variable and exit
gvarFeedbackValidBC = strExpr
ValidBC = True
Exit Function
Failure:
MsgBox Err.Description
Err.Clear
Exit Function
End Function
As can be seen, the top of the function is quite simple: the criteria is calculated and tested against the table (this traps the error “data type mismatch”). In order to build the feedback string, the field name is stripped from the expression, and passed to the localization function. If all went well, the final local expression should create the same predicate as the original user input. If not, it can be considered a syntax error — which is rather unfair if it's really due to a bug in the function!
Private Function Localize(pstrExpr As String) As String
Dim strLocal As String
Dim strC As String
Dim strToken As String
Dim strDecSep As String
Dim strLstSep As String
Dim fKeywords As Boolean
Dim i As Integer
Dim p As Integer
' get user's default decimal and list separators
strDecSep = winGetDecimalSeparator
strLstSep = winGetListSeparator
' (de)activate keyword translation based on UI language
Select Case LanguageSettings.LanguageID(2)
Case 1036, 4108 ' French and Swiss-French
fKeywords = True
End Select
i = 1
Do While i <= Len(pstrExpr)
strC = Mid(pstrExpr, i, 1)
Select Case strC
Case """", "'", "["
' don't mess with strings and protected names
If strC = "[" Then strC = "]"
p = InStr(i + 1, pstrExpr, strC)
If p = 0 Then Exit Do
strLocal = strLocal & Mid(pstrExpr, i, p - i + 1)
i = p
Case "#"
' localize date literal
p = InStr(i + 1, pstrExpr, strC)
If p = 0 Then Exit Do
strC = Mid(pstrExpr, i + 1, p - i - 1)
If IsDate(strC) Then strC = Eval("#" & strC & "#")
strLocal = strLocal & "#" & strC & "#"
i = p
Case "."
' convert to local decimal separator
If IsNumeric(Mid(pstrExpr, i + 1, 1)) Then strC = strDecSep
strLocal = strLocal & strC
Case ","
' convert to local list separator
strLocal = strLocal & strLstSep
Case "a" To "z"
' obtain full token (alphanumeric)
strToken = strC
Do While i <= Len(pstrExpr)
strC = Mid(pstrExpr, i + 1, 1)
If Not strC Like "[a-z_0-0]" Then Exit Do
strToken = strToken & strC
i = i + 1
Loop
If fKeywords Then
' substitute French keywords
Select Case strToken
Case "True": strToken = "Vrai"
Case "False": strToken = "Faux"
Case "Yes": strToken = "Oui"
Case "No": strToken = "Non"
Case "Is": strToken = "Est"
Case "Not": strToken = "Pas"
Case "And": strToken = "Et"
Case "Or": strToken = "Ou"
Case "Like": strToken = "Comme"
Case "Between": strToken = "Entre"
Case "In": strToken = "Dans"
End Select
End If
strLocal = strLocal & strToken
Case Else
strLocal = strLocal & strC
End Select
i = i + 1
Loop
If i <= Len(pstrExpr) Then strLocal = strLocal & Mid(pstrExpr, i)
Localize = strLocal
End Function
Localize() is a very basic expression parser and tokenizer. Characters are read one at a time and special action is taken for some of them: strings and “protected” words in square brackets are left intact; date literals are converted from US to local date format; list separators are replaced with the local choice; decimal separators are identified and replaced; tokens are discovered and extracted (a token is any alphanumeric string starting with a letter).
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (0)