Evo citava procedura koja radi u jednoj drugoj bazi
ption Compare Database 'Use database order for string comparisons
Option Explicit
Const QUOTE = """"
Private Function BuildSQLString(strFieldName As String, varFieldValue As Variant, 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
strTemp = "[" & strFieldName & "]"
' 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
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 (DB_BINARY?)
strTemp = ""
End Select
End If
BuildSQLString = strTemp
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 intI As Integer
Dim strLocalSQL As String
Dim strTemp As String
Dim varDataType As Integer
Dim varControlSource As Variant
Dim ctl As Control
For intI = 0 To frm.Count - 1
Set ctl = frm(intI)
' 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(CStr(varControlSource), ctl, CInt(varDataType)) & ")"
strLocalSQL = strLocalSQL & IIf(Len(strLocalSQL) = 0, strTemp, " AND " & strTemp)
End If
End If
On Error GoTo 0
End If
Next intI
If Len(strLocalSQL) > 0 Then strLocalSQL = "(" & strLocalSQL & ")"
BuildWHEREClause = strLocalSQL
End Function
Function glrDoQBF(strFormName As String, fCloseIt As Integer)
' 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 a null 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
' fCloseIt: 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 fCloseIt Then
DoCmd.Close acForm, strFormName
End If
End If
glrDoQBF = strSQL
End Function
Function glrQBF_DoClose()
' Close the current form.
DoCmd.Close
End Function
Function glrQBF_DoHide(frm As Form)
Dim varSQL As Variant
Dim strParentForm As String
'Get the name of the Parent form
strParentForm = Left(CStr(frm.Name), Len(CStr(frm.Name)) - 4)
'Create the approprite Where clause based on the fields with data in them
varSQL = glrDoQBF(CStr(frm.Name), False)
'Open the Parent form filtered with the Where clause genereated above
DoCmd.OpenForm strParentForm, acNormal, , varSQL
'Make this *_QBF form invisible
frm.Visible = False
End Function
Private Function isFormLoaded(strName As String)
' Return a logical value indicating whether a
' given formname is loaded or not.
On Error Resume Next
isFormLoaded = (SysCmd(acSysCmdGetObjectState, acForm, strName) <> 0)
If Err.Number <> 0 Then
isFormLoaded = False
End If
End Function
Private Function isOperator(varValue As Variant)
' Return a logical value indicating whether a
' value passed in is an operator or not.
' This is NOT infallible, and may need correcting.
Dim varTemp As Variant
varTemp = Trim(UCase(varValue))
isOperator = False
' Check first character for <,>, or =
If InStr("<>=", Left(varTemp, 1)) > 0 Then
isOperator = True
' Check for IN (x,y,z)
ElseIf ((Left(varTemp, 4) = "IN (") And (Right(varTemp, 1) = ")")) Then
isOperator = True
' Check for BETWEEN ... AND ...
ElseIf ((Left(varTemp,
= "BETWEEN ") And (InStr(varTemp, " AND ") > 0)) ThenisOperator = True
' Check for NOT xxx
ElseIf (Left(varTemp, 4) = "NOT ") Then
isOperator = True
' Check for LIKE xxx
ElseIf (Left(varTemp, 5) = "LIKE ") Then
isOperator = True
End If
End Function