Option Compare Database
Option Explicit
Dim mstrAnd As String
Dim mstrFilter As String
Function BuildWhereClause(frm As Form) As String
'********************************
'* Declaration Specifications *
'********************************
On Error GoTo ErrHandler
'****************
'* Initialize *
'****************
mstrFilter = vbNullString
mstrAnd = vbNullString
BuildWhereClause_DateRange frm
BuildWhereClause_ListBox frm
If (InStr(1, mstrFilter, "!!!Error!!!") > 0) Then
MsgBox "error"
BuildWhereClause = "!!!ERROR!!!"
Exit Function
End If
BuildWhereClause = mstrFilter
'********************
'* Exit Procedure *
'********************
ExitProcedure:
Exit Function
'****************************
'* Error Recovery Section *
'****************************
ErrHandler:
Err.Raise Err.Number,"BuildWhereClause" & ";" & Err.Source,Err.Description
End Function
Function BuildWhereClause_DateRange(frm As Form)
'********************************
'* Declaration Specifications *
'********************************
Dim ctl As Control
Dim ctlEndR As Control
Dim strField As String
Dim strType As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
On Error GoTo ErrHandler
'*********************************************************
'* Loop thru all controls on form to find list box(es) *
'*********************************************************
For Each ctl In frm.Controls
If (ctl.ControlType = acTextBox) And (Right$(ctl.Name, 7) = "_BeginR") Then
'*************************************************************************************************
'* Should this list box be processed? *
'* If so, then tag property contains the name of the table and field and the type of the field *
'* (Structure of tag property: Where=TableName.FieldName,DataType, ) *
'* NOTE that the code assumes the tag property is structured properly *
'*************************************************************************************************
If ((ctl.Enabled) And (Not ctl.Locked) And (InStr(ctl.Tag, "Where=") > 0)) Then
If (IsNull(ctl)) Then GoTo 7000
On Error Resume Next
Set ctlEndR = frm(Left$(ctl.Name, Len(ctl.Name) - 7) & "_EndR")
If (Err.Number = 2465) Then
Err.Clear
GoTo 7000
End If
If (IsNull(ctlEndR)) Then GoTo 7000
On Error GoTo ErrHandler
j = InStr(ctl.Tag, "Where=")
k = InStr(j, ctl.Tag, ",")
strField = Mid(ctl.Tag, j + 6, k - (j + 6))
j = InStr(k + 1, ctl.Tag, ";")
strType = Mid(ctl.Tag, k + 1, j - k - 1)
mstrFilter = mstrFilter & mstrAnd & " (" & strField & " Between #" & ctl.Value & "# AND #" & ctlEndR.Value & "#) "
mstrAnd = " AND "
End If
End If
7000:
Next
'********************
'* Exit Procedure *
'********************
ExitProcedure:
Exit Function
'****************************
'* Error Recovery Section *
'****************************
ErrHandler:
Err.Raise Err.Number,"BuildWhereClause_DateRange" & ";" & Err.Source,Err.Description
End Function
Function BuildWhereClause_ListBox(frm)
'********************************
'* Declaration Specifications *
'********************************
Dim ctl As Control
Dim varItem As Variant
Dim strField As String
Dim strType As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
On Error GoTo ErrHandler
'*********************************************************
'* Loop thru all controls on form to find list box(es) *
'*********************************************************
For Each ctl In frm.Controls
If (ctl.ControlType = acListBox) Then
'*************************************************************************************************
'* Should this list box be processed? *
'* If so, then tag property contains the name of the table and field and the type of the field *
'* (Structure of tag property: Where=TableName.FieldName,DataType; ) *
'* NOTE that the code assumes the tag property is structured properly *
'*************************************************************************************************
If ((ctl.Enabled) And (Not ctl.Locked) And (ctl.ItemsSelected.Count > 0) And (InStr(ctl.Tag, "Where=") > 0)) Then
j = InStr(ctl.Tag, "Where=")
k = InStr(j, ctl.Tag, ",")
strField = Mid(ctl.Tag, j + 6, k - (j + 6))
j = InStr(k + 1, ctl.Tag, ";")
strType = Mid(ctl.Tag, k + 1, j - k - 1)
mstrFilter = mstrFilter & mstrAnd & " (" & strField & " In ("
'******************************************
'* Loop thru items selected in list box *
'******************************************
For Each varItem In ctl.ItemsSelected
If (strType = "String") Then
mstrFilter = mstrFilter & "'" & ctl.Column(ctl.BoundColumn - 1, varItem) & "', "
ElseIf (strType = "Number") Then
mstrFilter = mstrFilter & ctl.Column(ctl.BoundColumn - 1, varItem) & ", "
End If
Next varItem
mstrFilter = Mid(mstrFilter, 1, Len(mstrFilter) - 2) & ")) "
mstrAnd = " AND "
End If
End If
Next
'********************
'* Exit Procedure *
'********************
ExitProcedure:
Exit Function
'****************************
'* Error Recovery Section *
'****************************
ErrHandler:
Err.Raise Err.Number,"BuildWhereClause_ListBox" & ";" & Err.Source,Err.Description
End Function