Navigation
Install the app
How to install the app on iOS
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
More options
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
Build Report Criteria via a Form w/list box, text box, date range
VBA and Custom Functions
Build Report Criteria via a Form w/list box, text box, date range
by
FancyPrairie
Posted
(Edited
)
.
***********************************************************
* NOTE: White spaces have been removed in some modules so that it would fit in Tek-Tips.
* The function BuildWhere_GetTag was modified on Aug 1, 2005
* to handle retrieving the field, operator and/or value from a control on the form
* (Where=
.[Field],String,Forms!Form1!YourControl).
*
* The function BuildWhere was modified on Feb 3, 2005 to add an
* extra parenthesis for a single select listbox.
* Also, BuildWhere_ControlType was changed to handle
* OptionButtons.
*
* The function BuildWhere was modified on Jan 19, 2005.
* Thank you TimS for discovering the problem.
***********************************************************
A Report Critieria form allows the user to select (via list boxes, text boxes, etc) the items they want included/excluded on a report.
The function below will loop thru all of the controls on a Report Criteria form and build the Where clause for the report (without the word Where). It handles 0 or more list boxes, text boxes, and text boxes that represent ranges (i.e. date ranges). It also handles check boxes and options groups.
The header of the main module will explain how to use the functions and it gives examples. Briefly, this is how it works. The Tag property of the controls is the key. The function only processes controls whose Tag property contain the tag that begins with Where= . And it is formatted as: [color red]Where=TableName.FieldName,FieldType[,Operator,Value;][/color]
Where= identifies the tag within the Tag property
TableName.FieldName represents the name of the table and the field within the table contained in the report's recordsource
FieldType must be either the word String, Date, or Number
Operator is optional and can be one of these: = < > <= >= <> Like IsNull (or the name of a control that contains the operator)
; (semicolon) is optional and separates additional tags within the Tag property
Value is optional and represents a specific value
Note that each item, within this tag, is separated by commas Example
For example, suppose your form contains a multiselect list box containing 2 columns from the department table (tblDept):
1. Department ID (lngID)
2. Department name (strFullName)
Note that the department ID column is the bound column and is hidden.
Now assume that your report references the employee table (tblEmp) which contains the department id field (lngDeptID).
The user can limit the report to only include those employees that belong to the department(s) selected in the list box. Simply add to the Tag Property [color red]Where=tblEmp.lngDeptID,Number;[/color]. That's all there is to it. Now open the report like this:
Docmd.OpenReport "rptYourReport",acViewPreview,,[color blue]BuildWhere(Me)[/color]
The function doesn't care about how you name your controls except if the controls are 2 text boxes that represent a range. That is, where the user enters the Begin Range in the first text box and the End Range in the 2nd text box. In this case, the name of the control must end with _BeginR for Begin Range and must end with _EndR for the End Range.
To use these functions, simply create a new module and copy the code below and paste it into your new module.
***********************************************************
* NOTE: White spaces have been removed in some modules so that it would fit in Tek-Tips.
* The function BuildWhere_GetTag was modified on Aug 1, 2005
* to handle retrieving the field, operator and/or value from a control on the form
* (Where=
*
* The function BuildWhere was modified on Feb 3, 2005 to add an
* extra parenthesis for a single select listbox.
* Also, BuildWhere_ControlType was changed to handle
* OptionButtons.
*
* The function BuildWhere was modified on Jan 19, 2005.
* Thank you TimS for discovering the problem.
***********************************************************
A Report Critieria form allows the user to select (via list boxes, text boxes, etc) the items they want included/excluded on a report.
The function below will loop thru all of the controls on a Report Criteria form and build the Where clause for the report (without the word Where). It handles 0 or more list boxes, text boxes, and text boxes that represent ranges (i.e. date ranges). It also handles check boxes and options groups.
The header of the main module will explain how to use the functions and it gives examples. Briefly, this is how it works. The Tag property of the controls is the key. The function only processes controls whose Tag property contain the tag that begins with Where= . And it is formatted as: [color red]Where=TableName.FieldName,FieldType[,Operator,Value;][/color]
Where= identifies the tag within the Tag property
TableName.FieldName represents the name of the table and the field within the table contained in the report's recordsource
FieldType must be either the word String, Date, or Number
Operator is optional and can be one of these: = < > <= >= <> Like IsNull (or the name of a control that contains the operator)
; (semicolon) is optional and separates additional tags within the Tag property
Value is optional and represents a specific value
Note that each item, within this tag, is separated by commas Example
For example, suppose your form contains a multiselect list box containing 2 columns from the department table (tblDept):
1. Department ID (lngID)
2. Department name (strFullName)
Note that the department ID column is the bound column and is hidden.
Now assume that your report references the employee table (tblEmp) which contains the department id field (lngDeptID).
The user can limit the report to only include those employees that belong to the department(s) selected in the list box. Simply add to the Tag Property [color red]Where=tblEmp.lngDeptID,Number;[/color]. That's all there is to it. Now open the report like this:
Docmd.OpenReport "rptYourReport",acViewPreview,,[color blue]BuildWhere(Me)[/color]
The function doesn't care about how you name your controls except if the controls are 2 text boxes that represent a range. That is, where the user enters the Begin Range in the first text box and the End Range in the 2nd text box. In this case, the name of the control must end with _BeginR for Begin Range and must end with _EndR for the End Range.
To use these functions, simply create a new module and copy the code below and paste it into your new module.
Code:
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 Between. Or it could specify a control on your form (i.e. forms!formName!YourControl)
'* (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.
'*
'* NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE..NOTE
'*
'* This routine assumes that the Where clause will include the AND statement between each set of statements.
'* For Example, (strLastName = 'Smith') AND (strFirstName = 'Justin') However, there are situations where
'* you may want the Where clause to include the OR statement between each set of statements. For example,
'* (strLastName = 'Smith') OR (strFirstName = 'Justin') In this case you need to tell this routine to use
'* OR rather than AND. Therefore, the first argument in this ParamArray should be " OR ".
'*
'* 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_EndR
'* 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)
'*
'* or Docmd.OpenReport "rptYourReport", acViewPreview, ,BuildWhere(Me, " OR ")
'*
'* or strWhere = BuildWhere(Me, " OR ")
'*
'-*********************************************************************************************************'
'
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 strOpt As String 'Operator between controls (AND or OR)
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
Dim k As Integer 'Working Variable
Dim bolAll As Boolean 'True if All controls on form to be processed
'****************
'* Initialize *
'****************
On Error GoTo ErrHandler
strWhere = vbNullString
strAnd = vbNullString
'**************************************
'* Begin loop thru controls on form *
'**************************************
If (UBound(varCtl) >= 0) Then
If (varCtl(0) = " OR ") Then strOpt = " OR " Else strOpt = " AND "
If (UBound(varCtl) = 0) And ((varCtl(0) = " OR ") Or (varCtl(0) = " AND ")) Then bolAll = True Else bolAll = False
Else
strOpt = " AND "
bolAll = True
End If
If (bolAll) Then
For Each ctl In frm.Controls
GoSub CreateWhere
Next
Else
If (varCtl(0) = " OR ") Or (varCtl(0) = " AND ") Then k = 1 Else k = 0
For i = k 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 = strOpt
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 = strOpt
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
strSuffix = ") "
End If
If (ctl.MultiSelect) Then
For Each varItem In ctl.ItemsSelected
If (Len(strOperator) = 0) Or (strOperator = "=") Then
strWhere = strWhere & strFieldType & ctl.Column(ctl.BoundColumn - 1, varItem) & strFieldType & strSuffix
Else
strWhere = strWhere & strAnd & "(" & strFieldName & " " & strOperator & " " & strFieldType & ctl.Column(ctl.BoundColumn - 1, varItem) & strFieldType & strSuffix
strAnd = " AND "
End If
Next varItem
If (Len(strOperator) = 0) Or (strOperator = "=") Then
strWhere = Mid(strWhere, 1, Len(strWhere) - Len(strSuffix)) & ")) "
Else
strWhere = Mid(strWhere, 1, Len(strWhere) - Len(strSuffix)) & ") "
End If
Else
If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Column(ctl.BoundColumn - 1)
If (Len(strOperator) = 0) Or (strOperator = "=") Then
strWhere = strWhere & strFieldType & strFieldValue & strFieldType & ")) "
Else
strWhere = strWhere & strAnd & "(" & strFieldName & " " & strOperator & " " & strFieldType & ctl.Column(ctl.BoundColumn - 1, varItem) & strFieldType & ") "
End If
End If
strAnd = strOpt
Return
'##########################################################################################
'# Text Box #
'##########################################################################################
BuildTextBox:
If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value
strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "
strAnd = strOpt
Return
'##########################################################################################
'# Option Group #
'##########################################################################################
BuildOptionGroup:
If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value
strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "
strAnd = strOpt
Return
'##########################################################################################
'# Check Box #
'##########################################################################################
BuildCheckBox:
If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Value
strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " " & strFieldType & strFieldValue & strFieldType & ") "
strAnd = strOpt
Return
'##########################################################################################
'# Combo Box #
'##########################################################################################
BuildComboBox:
'*******************************************
'* Determine Operator (=, >, Like, etc.) *
'*******************************************
strAndOr = vbNullString
If (Len(strOperator) = 0) Or (strOperator = "=") Then
strWhere = strWhere & strAnd & " (" & strFieldName & " = "
strSuffix = ") "
Else
strWhere = strWhere & strAnd & " (" & strFieldName & " " & strOperator & " "
strSuffix = ") "
End If
If (Len(strFieldValue) = 0) Then strFieldValue = ctl.Column(ctl.BoundColumn - 1)
strWhere = strWhere & strFieldType & strFieldValue & strFieldType & strSuffix
strAnd = strOpt
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:
'*
'-********************************************************************************************
'
Function BuildWhere_ControlType(frm As Form, ctl As Control) As String
'********************************
'* Declaration Specifications *
'********************************
Dim strTemp As String 'Working variable
Dim varValue As Variant '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 = acOptionButton) Or (ctl.ControlType = acCheckBox)) And (ctl.Enabled) And (ctl.Visible) Then
If (ctl.ControlType = acOptionButton) Then
If (ctl.Parent.ControlType = acOptionGroup) Then
If (ctl.OptionValue = ctl.Parent.Value) Then varValue = ctl.Parent.Value Else varValue = Null
Else
varValue = ctl.Value
End If
Else
varValue = ctl.Value
End If
If (Not IsNull(varValue)) And (Len(varValue) > 0) 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) Or (ctl.ControlType = acOptionButton) Then
BuildWhere_ControlType = "OptionGroup"
ElseIf (ctl.ControlType = acCheckBox) Then
BuildWhere_ControlType = "CheckBox"
End If
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 '-********************************************************************************************
'
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
'*
'-********************************************************************************************
'
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
On Error Resume Next
Eval(var(0))
If (Err.Number) Then
Err.Clear
BuildWhere_GetTag = Trim(CStr(var(0)))
Else
BuildWhere_GetTag = Eval(var(0))
End If
On Error GoTo ErrHandler
'***************
'* 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
On Error Resume Next
Eval(var(2))
If (Err.Number) Then
Err.Clear
BuildWhere_GetTag = Trim(CStr(var(2)))
Else
BuildWhere_GetTag = Eval(var(2))
End If
On Error GoTo ErrHandler
End If
'***********
'* Value *
'***********
ElseIf (strFunction = "Value") Then
If (UBound(var) < 3) Then
BuildWhere_GetTag = vbNullString
Else
On Error Resume Next
Eval(var(3))
If (Err.Number) Then
Err.Clear
BuildWhere_GetTag = Trim(CStr(var(3)))
Else
BuildWhere_GetTag = Eval(var(3))
End If
On Error GoTo ErrHandler
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
Please Note: 1 is Bad, 10 is Good :-)
Part and Inventory Search
-
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.