Here is a VBA solution your problem:
Option Compare Database
Option Explicit
'*******************************************
'* Constant Declarations for this module *
'*******************************************
Const mstrcTagID As String
= "Where=" 'Tag Property identifier to build
Where Clause
Const mstrcRange_Begin As String
= "_BeginR" 'String to be appended to the base name
of a control that represents the Begin part of a range
Const mstrcRange_End As String
= "_EndR" 'String to be appended to the base
name of a control that represents the End part of a range
Const mstrcDateSymbol
= "#" 'Symbol for dates (i.e. Date
= #10/24/2004#)
Const mstrcFldSeparator
= "," 'Separates items with Where=
Tag
Const mstrcStringSymbol
= "'" 'Symbol for strings (i.e.
where name = 'dog')
Const mstrcTagSeparator
= ";" 'Separates Tag items in
controls Tag Property
'+*********************************************************
***********************************
'*
'$ Function: BuildWhere
'*
'* Author: FancyPrairie
'*
'* Date: October, 1998
'*
'* Purpose: This routine will build a Where clause
based on the items the user selected/entered on a
'* Report Criteria form (or any type of form
that the caller may use to build a Where clause
'* based on the items selected).
'*
'* This routine assumes that, in order for
the control to be included in the criteria,
'* it must satisfy the following conditions:
'*
'* 1. Tag Property must contain:
Where=TableName.FieldName,FieldType[,Operator,Value]
'* a. TableName.FieldName is the
name of the Table and field to filter on
'* (example:
tblEmployee.lngEmpID)
'* b. FieldType must be one of the
following words: String, Date
'* (Note: String and Date are
the only ones that have special meaning at this time
'* (' or #). However,
if the FieldType is not String or Date then set
'* you can leave the
FieldType empty or (anticipating future uses) set the
FieldType
'* to Long, Integer,
Byte, Single, Double, Boolean.)
'* c. Operator (optional) can be
one of the following: = <> < > <= >= Like IsNull
'* (Default is =)
'* d. Value (optional) to be
filtered on (more for option groups and check boxes)
'* (Note: This is primarily
intended to be used by Option groups and check boxes.
'* For example, suppose
you have a check box. If the box is checked, then
'* the you need to set
the Value argument equal to True and the FieldType
'* should be set to
Boolean. Else Value should be set to False.)
'* 2. Control must be Enabled
'* 3. Control must be visible
'* 4. If the control is part of a range,
then the name of the control must end with
'* either _BeginR (begin range
control) or _EndR (end range control)
'*
'* As of this writing, the following controls
are checked:
'* 1. List Boxes (multiselect and single
select)
'* 2. Ranges (2 controls that are grouped
together (i.e. Begin and End Dates)
'* 3. Text Boxes
'* 4. Combo Boxes
'* 5. Option Groups
'* 6. Check Boxes
'*
'* Arguments: frm (form)
'* ----------
'* Represents the form (Report Criteria form)
that contains the controls
'* from which the Where clause is to be
created.
'*
'* varCtl (ParamArray)
'* -------------------
'* Indicates which controls you want
checked. If this argument is missing then
'* this routine loops thru all of the
controls on the form searching for the ones
'* whose tag property is set accordingly.
Else it only checks the ones passed by the caller.
'*
'* Control Examples:
'*
'* ListBox
'* -------
'* Visible ........ Yes
'* Enabled ........ Yes
'* Multi Select ... None, Simple, or
Extended
'* Tag ............
Where=tblEmployee.lngDepartmentID,Number;
'*
'* TextBox
'* -------
'* Visible ........ Yes
'* Enabled ........ Yes
'* Tag ............
Where=tblEmployee.dteBirth,Date,>;
'*
'* Range
'* -----
'* Text Box (Begin Date Range: Name must
end with _BeginR)
'* Name ...... txtHireDate_BeginR
'* Visible ... Yes
'* Enabled ... Yes
'* Tag .......
Where=tblEmployee.dteHire,Date;
'*
'* Text Box (End Date Range: Name must end
with _EndR)
'* Name ...... txtHireDate_BeginR
'* Visible ... Yes
'* Enabled ... Yes
'* Tag ....... (not used...function
relies on tag property of BeginDateRange text box)
'*
'* Option Group
'* ------------
'* Visible ... Yes
'* Enabled ... Yes
'* Tag .......
Where=tblEmployee.lngID,Long,=,3;
'*
'* Check Boxes
'* -----------
'* Visible ... Yes
'* Enabled ... Yes
'* Tag .......
Where=tblEmployee.ysnActive,Boolean,=,True;
'*
'* Calling Example:
'*
Docmd.OpenReport "rptYourReport",acViewPreview,,BuildWhere
(Me)
'*
'* or strWhere = BuildWhere(Me)
'*
'-
***********************************************************
**********************************************'
'
Function BuildWhere(frm As Form, _
ParamArray varCtl() As Variant)
'********************************
'* Declaration Specifications *
'********************************
Dim ctl As Control 'Control currently
being processed
Dim ctlEndR As Control '2nd control of
Range pair
Dim varItem As Variant 'Items within
multiselect list box
Dim strAnd As String 'And or ""
Dim strAndOr As String 'Either "And"
or "Or"
Dim strCtlType As String 'Control Type of
control being processed (also see error handler)
Dim strFieldName As String 'Table.FieldName
value
Dim strFieldType As String 'FieldType ' or #
Dim strFieldValue As String 'Value
Dim strOperator As String 'Operator (= <> >
< etc)
Dim strSuffix As String 'Suffix to be
appended at end of a string
Dim strWhere As String 'Where clause to
be returned to caller
Dim i As Integer 'Working Variable
'****************
'* Initialize *
'****************
On Error GoTo ErrHandler
strWhere = vbNullString
strAnd = vbNullString
'**************************************
'* Begin loop thru controls on form *
'**************************************
If (UBound(varCtl) = -1) Then
For Each ctl In frm.Controls
GoSub CreateWhere
Next
Else
For i = 0 To UBound(varCtl)
Set ctl = varCtl(i)
GoSub CreateWhere
Next i
End If
'***********************
'* Save Where Clause *
'***********************
BuildWhere = strWhere
'********************
'* Exit Procedure *
'********************
ExitProcedure:
Exit Function
'*********************************************
'* Create Where Clause for current control *
'*********************************************
CreateWhere:
strCtlType = BuildWhere_ControlType(frm, ctl)
Select Case strCtlType
Case "Range": GoSub GetTag: GoSub
BuildRange 'strWhere = strWhere & strAnd &
BuildWhere_Range(frm, ctl)
Case "ListBox": GoSub GetTag: GoSub
BuildListBox 'strWhere = strWhere & strAnd &
BuildWhere_ListBox(frm, ctl)
Case "TextBox": GoSub GetTag: GoSub
BuildTextBox 'strWhere = strWhere & strAnd &
BuildWhere_TextBox(frm, ctl)
Case "OptionGroup": GoSub GetTag: GoSub
BuildOptionGroup 'strWhere = strWhere & strAnd &
BuildWhere_OptionGroup(frm, ctl)
Case "CheckBox": GoSub GetTag: GoSub
BuildCheckBox 'strWhere = strWhere & strAnd &
BuildWhere_CheckBox(frm, ctl)
Case "ComboBox": GoSub GetTag: GoSub
BuildComboBox
End Select
If (Len(strWhere) > 0) Then strAnd = " AND "
Return
'##########################################################
################################
'# Retrieve Tag
Items #
'##########################################################
################################
GetTag:
strFieldName = BuildWhere_GetTag("FieldName", ctl.Tag)
If (Len(strFieldName) = 0) Then Err.Raise
vbObjectError + 2000, "BuildWhere (GetTag);" &
Err.Source, "Invalid Tag Property (" & ctl.Tag & ")" &
vbCrLf & vbCrLf & "The Tag Property should look like
this:" & vbCrLf & mstrcTagID & "TableName.FieldName" &
mstrcFldSeparator & "FieldType[" & mstrcFldSeparator
& "Operator]" & vbCrLf & vbCrLf & "(where FieldType is
either String, Date, or Number and Operator (optional) is
either =, <>, <, >, <=, >=, Like)"
strFieldType = BuildWhere_GetTag("FieldType", ctl.Tag)
strOperator = BuildWhere_GetTag("Operator", ctl.Tag)
strFieldValue = BuildWhere_GetTag("Value", ctl.Tag)
Return
'##########################################################
################################
'# Build
Range #
'##########################################################
################################
BuildRange:
'******************************************************
****
'* Determine control that represents the End date
range *
'******************************************************
****
On Error Resume Next
Set ctlEndR = frm(Left$(ctl.Name, Len(ctl.Name) - Len
(mstrcRange_Begin)) & mstrcRange_End)
If (Err.Number = 2465) Then
On Error GoTo 0
Err.Raise vbObjectError + 2001, "BuildWhere (" &
strCtlType & ");" & Err.Source, "Invalid Range" & vbCrLf &
vbCrLf & "You have declared a text box that represents the
Begin Range (" & ctl.Name & ") but you did not declare a
control that represents the End Range (" & Left$(ctl.Name,
Len(ctl.Name) - Len(mstrcRange_Begin)) & mstrcRange_End
& ")"
End If
If (IsNull(ctlEndR)) Then
On Error GoTo 0
Err.Raise vbObjectError + 2002, "BuildWhere (" &
strCtlType & ");" & Err.Source, "Invalid Range" & vbCrLf &
vbCrLf & "Your entered a value for the Begin Range but
failed to enter a value for the End Range."
End If
'*****************
'* Build Where *
'*****************
On Error GoTo ErrHandler
If (Len(strFieldValue) = 0) Then strFieldValue = CStr
(ctl.Value)
If (strFieldType = "#") Then 'IFT, then Date Field
strWhere = strWhere & strAnd & " (" & strFieldName
& " Between #" & strFieldValue & "# AND #" & ctlEndR.Value
& " 23:59:59#) "
Else
strWhere = strWhere & strAnd & " (" & strFieldName
& " Between " & strFieldType & strFieldValue &
strFieldType & " AND " & strFieldType & ctlEndR.Value &
strFieldType & ") "
End If
strAnd = " AND "
Return
'##########################################################
################################
'# List
Box #
'##########################################################
################################
BuildListBox:
'*******************************************
'* Determine Operator (=, >, Like, etc.) *
'*******************************************
strAndOr = vbNullString
If (Len(strOperator) > 0) Then
If (strOperator = "<>") Then strAndOr = " AND "
Else strAndOr = " OR "
End If
If (Len(strOperator) = 0) Or (strOperator = "=") Then
strWhere = strWhere & strAnd & " (" & strFieldName
& " In ("
strSuffix = ", "
Else
strWhere = strWhere & strAnd & " (" & strFieldName
& " " & strOperator & " "
strSuffix = ") " & strAndOr
End If
If (ctl.MultiSelect) Then
For Each varItem In ctl.ItemsSelected
strWhere = strWhere & strFieldType & ctl.Column
(ctl.BoundColumn - 1, varItem) & strFieldType & strSuffix
Next varItem
strWhere = Mid(strWhere, 1, Len(strWhere) - Len
(strSuffix)) & ")) "
Else
If (Len(strFieldValue) = 0) Then strFieldValue =
ctl.Column(ctl.BoundColumn - 1)
strWhere = strWhere & strFieldType & strFieldValue
& strFieldType & strSuffix
End If
strAnd = " AND "
Return
'##########################################################
################################
'# Text
Box #
'##########################################################
################################
BuildTextBox:
If (Len(strFieldValue) = 0) Then strFieldValue =
ctl.Value
strWhere = strWhere & strAnd & " (" & strFieldName
& " " & strOperator & " " & strFieldType & strFieldValue &
strFieldType & ") "
strAnd = " AND "
Return
'##########################################################
################################
'# Option
Group #
'##########################################################
################################
BuildOptionGroup:
If (Len(strFieldValue) = 0) Then strFieldValue =
ctl.Value
strWhere = strWhere & strAnd & " (" & strFieldName
& " " & strOperator & " " & strFieldType & strFieldValue &
strFieldType & ") "
strAnd = " AND "
Return
'##########################################################
################################
'# Check
Box #
'##########################################################
################################
BuildCheckBox:
If (Len(strFieldValue) = 0) Then strFieldValue =
ctl.Value
strWhere = strWhere & strAnd & " (" & strFieldName
& " " & strOperator & " " & strFieldType & strFieldValue &
strFieldType & ") "
strAnd = " AND "
Return
'##########################################################
################################
'# Combo
Box #
'##########################################################
################################
BuildComboBox:
'*******************************************
'* Determine Operator (=, >, Like, etc.) *
'*******************************************
strAndOr = vbNullString
If (Len(strOperator) > 0) Then
If (strOperator = "<>") Then strAndOr = " AND "
Else strAndOr = " OR "
End If
If (Len(strOperator) = 0) Or (strOperator = "=") Then
strWhere = strWhere & strAnd & " (" & strFieldName
& " In ("
strSuffix = ", "
Else
strWhere = strWhere & strAnd & " (" & strFieldName
& " " & strOperator & " "
strSuffix = ") " & strAndOr
End If
If (Len(strFieldValue) = 0) Then strFieldValue =
ctl.Column(ctl.BoundColumn - 1)
strWhere = strWhere & strFieldType & strFieldValue &
strFieldType & strSuffix
strAnd = " AND "
Return
'****************************
'* Error Recovery Section *
'****************************
ErrHandler:
Err.Raise Err.Number, "BuildWhere (" & strCtlType
& ");" & Err.Source, Err.Description
End Function
'+*********************************************************
***********************************
'*
'$ Function: BuildWhere_ControlType
'*
'* Author: FancyPrairie
'*
'* Date: April, 1998
'*
'* Purpose: This routine determines if a control
should be included (valid) if it meets the following
conditions:
'*
'* List Boxes
'* 1. Tag Property contains: Where=
'* 2. At least one item selected
'* 3. List Box is enabled
'* 4. List Box is visible
'*
'* Range
'* 1. Tag Property contains: Where=
'* 2. Name of control ends with "_Begin"
'* 3. Value of control is NOT Null
'* 4. Control is enabled
'* 5. Control is visible
'*
'* Text Box
'* 1. Tag Property contains: Where=
'* 2. Value of control is NOT Null
'* 3. Control is enabled
'* 4. Control is visible
'*
'* Combo Boxes
'* 1. Tag Property contains: Where=
'* 2. One item selected
'* 3. Combo Box is enabled
'* 4. Combo Box is visible
'*
'-
***********************************************************
*********************************
'
Function BuildWhere_ControlType(frm As Form, ctl As
Control) As String
'********************************
'* Declaration Specifications *
'********************************
Dim strTemp As String 'Working variable
'****************
'* Initialize *
'****************
On Error GoTo ErrHandler
BuildWhere_ControlType = vbNullString 'Assume
invalid
strTemp = Replace(ctl.Tag, " ", vbNullString) 'Strip
out all spaces
If (InStr(strTemp, mstrcTagID) > 0) Then 'If
true, Tag Property contains "Where="
If (ctl.ControlType = acListBox) Then
If (ctl.MultiSelect) And
(ctl.ItemsSelected.Count > 0) And (ctl.Enabled) And
(ctl.Visible) Then BuildWhere_ControlType = "ListBox"
If (Not ctl.MultiSelect) And (Not IsNull
(ctl.Value)) And (ctl.Enabled) And (ctl.Visible) Then
BuildWhere_ControlType = "ListBox"
ElseIf ((ctl.ControlType = acTextBox) Or
(ctl.ControlType = acComboBox) Or (ctl.ControlType =
acOptionGroup) Or (ctl.ControlType = acCheckBox)) And (Not
IsNull(ctl.Value)) And (Len(ctl.Value) > 0) And
(ctl.Enabled) And (ctl.Visible) Then
If (Right$(ctl.Name, Len(mstrcRange_End)) =
mstrcRange_End) Then GoTo ExitProcedure
If (Right$(ctl.Name, Len(mstrcRange_Begin)) =
mstrcRange_Begin) Then
On Error GoTo 0
If (Not BuildWhere_ValidRange(frm, ctl))
Then Err.Raise vbObjectError +
2002, "BuildWhere_ControlType", "Incomplete Range
Specifications." & vbCrLf & vbCrLf & "You failed to
enter/select a value for " & ctl.Name
On Error GoTo ErrHandler
BuildWhere_ControlType = "Range"
ElseIf (ctl.ControlType = acTextBox) Then
BuildWhere_ControlType = "TextBox"
ElseIf (ctl.ControlType = acComboBox) Then
BuildWhere_ControlType = "ComboBox"
ElseIf (ctl.ControlType = acOptionGroup) Then
BuildWhere_ControlType = "OptionGroup"
ElseIf (ctl.ControlType = acCheckBox) Then
BuildWhere_ControlType = "CheckBox"
End If
End If
End If
'********************
'* Exit Procedure *
'********************
ExitProcedure:
Exit Function
'****************************
'* Error Recovery Section *
'****************************
ErrHandler:
Err.Raise Err.Number, "BuildWhere_ControlType;" &
Err.Source, Err.Description
End Function
'+*********************************************************
***********************************
'*
'$ Function: BuildWhere_ValidRange
'*
'* Author: FancyPrairie
'*
'* Date: April, 1998
'*
'* Purpose: Determines if the values of 2 controls,
that represent ranges, are valid. They are not valid
'* if one or both controls do not contain a
value. For example, the user may have entered a begin
'* date, but failed to enter an end date.
'*
'* Arguments: frm (form)
'* ----------
'* Form that contains the controls to be
processed.
'*
'* avarParControls (variant Parameter Array)
'* -----------------------------------------
'* List of contol(s) to be processed. If
this array is empty, then this routine will
'* retrieve all of the "valid" controls on
the form specified.
'*
'-
***********************************************************
*********************************
'
Function BuildWhere_ValidRange(frm As Form, ctl As
Control) As Boolean
'********************************
'* Declaration Specifications *
'********************************
Dim ctlEnd As Control
'**********************************************************
********
'* Create array with just those text boxes that meet the
specs. *
'**********************************************************
********
On Error GoTo ErrHandler
Set ctlEnd = frm(Left(ctl.Name, Len(ctl.Name) - Len
(mstrcRange_Begin)) & mstrcRange_End)
If (IsNull(ctl)) Or (Len(ctl) = 0) Or (IsNull(ctlEnd))
Or (Len(ctlEnd) = 0) Then
BuildWhere_ValidRange = False
Else
BuildWhere_ValidRange = True
End If
'********************
'* Exit Procedure *
'********************
ExitProcedure:
Exit Function
'****************************
'* Error Recovery Section *
'****************************
ErrHandler:
Err.Raise Err.Number, "BuildWhere_ValidRange;" &
Err.Source, Err.Description
End Function
'+*********************************************************
***********************************
'*
'$ Function: BuildWhere_GetTag
'*
'* Author: FancyPrairie
'*
'* Date: April, 1998
'*
'* Purpose: This routine will return the value for a
given Tag Item. The caller specifies
'* which item they want returned. Possible
items are:
'* 1. FieldName
'* 2. FieldType
'* 3. Operator
'* 4. Value
'*
'* Note that this routine assumes the Tag
Property contains an item that is formatted as:
'* Where=TableName.TableField,FieldType
[,Operator,Value].
'*
'* Arguments: strFunction (string)
'* --------------------
'* Can be one of: FieldName, FieldType,
Operator, Value
'*
'* strTag (string)
'* ---------------
'* String that contains an item that is
formatted as:
'* Where=TableName.TableField,FieldType
[,Operator,Value].
'*
'-
***********************************************************
*********************************
'
Function BuildWhere_GetTag(strFunction As String, strTag
As String) As String
'********************************
'* Declaration Specifications *
'********************************
Dim i As Integer 'Working variable
Dim j As Integer 'Working variable
Dim k As Integer 'Working variable
Dim strTemp As String 'Working variable
Dim var As Variant 'Working variable
On Error GoTo ErrHandler
'**********************************************************
****
'* Loop to find "Where=" Tag within Controls Tag
Property *
'* When the "Where=" is found, then parse out the
item *
'* the caller requested (i.e.
FieldName,FieldType,Operator) *
'**********************************************************
****
var = Split(strTag, mstrcTagSeparator)
BuildWhere_GetTag = vbNullString
For i = 0 To UBound(var)
strTemp = Replace(CStr(var(i)), " ", vbNullString)
j = InStr(1, strTemp, mstrcTagID) 'Find "Where="
If (j = 1) Then 'If true,
found "Where="
strTemp = CStr(var(i))
j = InStr(1, strTemp, "=")
var = Split(Mid(strTemp, j + 1),
mstrcFldSeparator)
'***************
'* FieldName *
'***************
If (strFunction = "FieldName") Then
BuildWhere_GetTag = Trim(CStr(var(0)))
'***************
'* FieldType *
'***************
ElseIf (strFunction = "FieldType") Then
If (UBound(var) < 1) Then
BuildWhere_GetTag = vbNullString
Else
Select Case Trim(CStr(var(1)))
Case "String": BuildWhere_GetTag =
mstrcStringSymbol
Case "Date": BuildWhere_GetTag =
mstrcDateSymbol
Case Else: BuildWhere_GetTag =
vbNullString
End Select
End If
'**************
'* Operator *
'**************
ElseIf (strFunction = "Operator") Then
If (UBound(var) < 2) Then
BuildWhere_GetTag = "=" Else BuildWhere_GetTag = Trim(CStr
(var(2)))
'***********
'* Value *
'***********
ElseIf (strFunction = "Value") Then
If (UBound(var) < 3) Then
BuildWhere_GetTag = vbNullString
Else
BuildWhere_GetTag = Trim(CStr(var(3)))
End If
End If
Exit Function
End If
Next i
'********************
'* Exit Procedure *
'********************
ExitProcedure:
Exit Function
'********************
'* Error Recovery *
'********************
ErrHandler:
Err.Raise Err.Number, "BuildWhere_GetTag;" &
Err.Source, Err.Description
End Function
