Option Compare Database 'Use database order for string comparisons
Option Explicit
' REQUIRES A REFERENCE TO Microsoft DAO 3.6.
Const QUOTE = """"
' This string is the text that gets appended
' to the chosen form name, once it's become a
' QBF form. It's completely arbitrary, and can be
' anything you like.
Public Const conQBFSuffix = "_QBF"
Private Function BuildSQLString( _
ByVal strFieldName As String, _
ByVal varFieldValue As Variant, _
ByVal intFieldType As Integer)
' Build string that can be used as part of an
' SQL WHERE clause. This function looks at
' the field type for the specified table field,
' and constructs the expression accordingly.
Dim strTemp As String
On Error GoTo HandleErrors
If Left$(strFieldName, 1) <> "[" Then
strTemp = "[" & strFieldName & "]"
End If
' If the first part of the value indicates that it's
' to be left as is, leave it alone. Otherwise,
' munge the value as necessary.
If IsOperator(varFieldValue) Then
strTemp = strTemp & " " & varFieldValue
Else
' One could use the BuildCriteria method here,
' but it's not as flexible as I'd like to
' be. So, this code does all the work manually.
Select Case intFieldType
Case dbBoolean
' Convert to TRUE/FALSE
strTemp = strTemp & " = " & CInt(varFieldValue)
Case dbText, dbMemo
' Assume we're looking for anything that STARTS with the
text we got.
' This is probably a LOT slower. If you want direct
matches
' instead, use the commented-out line.
' strTemp = strTemp & " = " & QUOTE & varFieldValue & QUOTE
strTemp = strTemp & " LIKE " & QUOTE & varFieldValue & "*"
&
QUOTE
Case dbByte, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble
' Convert to straight numeric representation.
strTemp = strTemp & " = " & varFieldValue
Case dbDate
' Convert to #date# format.
strTemp = strTemp & " = " & "#" & varFieldValue & "#"
Case Else
' This function really can't handle any of the other data
types. You can
' add more types, if you care to handle them.
strTemp = vbNullString
End Select
End If
BuildSQLString = strTemp
ExitHere:
Exit Function
HandleErrors:
MsgBox "Error: " & Err.Description & " (" & Err.Number & ")",
vbExclamation, "BuildSQLString"
strTemp = vbNullString
Resume ExitHere
End Function
Private Function BuildWHEREClause(frm As Form) As String
' Build the full WHERE clause based on fields
' on the passed-in form. This function attempts
' to look at all controls that have the correct
' settings in the Tag properties.
Dim strLocalSQL As String
Dim strTemp As String
Dim varDataType As Integer
Dim varControlSource As Variant
Dim ctl As Control
'var for list control reference
Const conAND As String = " AND "
For Each ctl In frm.Controls
' Get the original control source.
varControlSource = adhCtlTagGetItem(ctl, "qbfField")
If Not IsNull(varControlSource) Then
' If the value of the control isn't null...
If Not IsNull(ctl) Then
' then get the value.
varDataType = adhCtlTagGetItem(ctl, "qbfType")
If Not IsNull(varDataType) Then
strTemp = "(" & BuildSQLString(varControlSource, ctl,
varDataType) & ")"
strLocalSQL = strLocalSQL & conAND & strTemp
End If
End If
End If
Next ctl
' Trim off the leading " AND "
If Len(strLocalSQL) > 0 Then
BuildWHEREClause = "(" & Mid$(strLocalSQL, Len(conAND) + 1) & ")"
End If
End Function
Public Function DoQBF(ByVal strFormName As String, _
Optional blnCloseIt As Boolean = True) As String
' Load the specified form as a QBF form. If
' the form is still loaded when control returns
' to this function, then it will attempt to
' build an SQL WHERE clause describing the
' values in the fields. DoQBF() will return
' either that SQL string or an empty string,
' depending on what the user chose to do and
' whether or not any fields were filled in.
' In:
' strFormName: Name of the form to load
' blnCloseIt: Close the form, if the user didn't?
' Out:
' Return Value: The calculated SQL string.
Dim strSQL As String
DoCmd.OpenForm strFormName, WindowMode:=acDialog
' You won't get here until user hides or closes the form.
' If the user closed the form, there's nothing
' to be done. Otherwise, build up the SQL WHERE
' clause. Once you're done, if the caller requested
' the QBF form to be closed, close it now.
If IsFormLoaded(strFormName) Then
strSQL = BuildWHEREClause(Forms(strFormName))
If blnCloseIt Then
DoCmd.Close acForm, strFormName
End If
End If
DoQBF = strSQL
End Function
Public Function QBFDoClose()
' This is a function so it can be called easily
' from the Properties window directly.
' Close the current form.
On Error Resume Next
DoCmd.Close
End Function
Public Function QBFDoHide(frm As Form)
' This is a function so it can be called easily
' from the Properties window directly.
Dim strSQL As String
Dim strParent As String
'Get the name of the Parent form
strParent = adhGetItem(frm.Tag, "Parent") & vbNullString
'Create the appropriate WHERE clause based on the fields with data in
them.
strSQL = DoQBF(frm.Name, False)
If Len(strParent) > 0 Then
'Open the Parent form filtered with the Where clause generated
above
DoCmd.OpenForm FormName:=strParent, View:=acNormal,
WhereCondition:=strSQL
End If
'Make this QBF form invisible.
frm.Visible = False
End Function
Private Function IsFormLoaded(strName As String) As Boolean
' Return a logical value indicating whether a
' given formname is loaded or not.
' You could use the IsLoaded property of a member
' of the AllForms collection to get this information, but
' that method raises an error if you ask about a
' for that doesn't exist. The obscure SysCmd function
' does not.
On Error Resume Next
IsFormLoaded = (SysCmd(acSysCmdGetObjectState, acForm, strName) <> 0)
End Function
Private Function IsOperator(varValue As Variant) As Boolean
' Return a logical value indicating whether a
' value passed in is an operator or not.
' This is NOT infallible, and may need correcting.
Dim strTemp As String
strTemp = Trim$(UCase(varValue))
IsOperator = False
' Check first character for <,>, or =
If InStr(1, "<>=", Left$(strTemp, 1)) > 0 Then
IsOperator = True
' Check for IN (x,y,z)
ElseIf ((Left$(strTemp, 4) = "IN (") And (Right$(strTemp, 1) = ")"))
Then
IsOperator = True
' Check for BETWEEN ... AND ...
ElseIf ((Left$(strTemp, 8) = "BETWEEN ") And (InStr(1, strTemp, " AND
")
IsOperator = True
' Check for NOT xxx
ElseIf (Left$(strTemp, 4) = "NOT ") Then
IsOperator = True
' Check for LIKE xxx
