A
Anthony
Public Function fSearchList(Optional whichField As Byte)
Dim i As Byte 'counter
Dim sql_And_or_Where As String 'Used to store the SQL word "AND" or
"WHERE",
'depending on whether or not the
existing SQL
'statement contains the word "AND".
Dim j As Integer 'another counter
Dim slField As Control 'A control variable representing the
search-list textbox
Dim new_slSQL As String 'Used to store the SQL string for
later use
Dim criteriaFound As Boolean
Dim ActiveField_Set As Boolean
Dim k As Integer 'another counter
Dim slCriteria_Field() As String
Dim addSpace As Boolean 'for programmatically adding a space
to the search text, if it was entered
Dim adjustOrderBy As Boolean 'Adjust "ORDER BY" SQL
Dim err_2185_Flag As Byte 'used in error handling at the end
of this function
On Error GoTo ErrHandler
Select Case whichField 'whichField variable is the number
of the active
'search text box, for example:
"Company Name" = 2
Case sl_Initialize 'sl_Initialize constant is for
nullifying all
'search-list text boxes.
For i = 1 To slFieldLimit 'slFieldLimit is assigned when the
search screen
'loads for the first time. For
Example:
'Client Search form has slFieldLimit
of 8
slForm("txtSL" & i) = Null 'Nullify each search-list
text box.
Next i
Case Else
If whichField <> 0 Then
If slActiveField.ControlType = acTextBox Then
'slActiveField is set when the textbox receives the focus
err_2185_Flag = 1 'This
flag is used in error handling at the end of this function
If Right(slActiveField.Text, 1) = " " Then ' if a space
was entered
addSpace = True
End If
skip_Block1:
End If
End If
End Select
slForm("SF").SetFocus 'slForm is the form object set to the search
form (example: "Admin")
'"SF" is a textbox that receives the focus
at times when nothing else should
'receive the focus.
new_slSQL = slSQL 'This variable holds the SQL string and is
used to recontruct it.
sql_And_or_Where = " WHERE " 'The default assignment to this string
variable is " WHERE " because
'that is what is used at the first
firing of this function. It is later
'changed to " AND " when more search
criteria is entered in other text boxes.
For i = 1 To slFieldLimit 'Loop through each search field
For j = 1 To Len(new_slSQL) 'Loop through each character of the
SQL string
If Mid(new_slSQL, j, 5) = "WHERE" Then 'If the word "WHERE"
is found in the SQL string
sql_And_or_Where = " AND " 'Change the variable
value to " AND "
Exit For 'Exit Loop
End If
Next j
Set slField = slForm("txtSL" & i) 'Set the slField to
the specific textbox analyzed at this i
If Nz(slField, "") <> "" Then 'If the value of
slField is not nothing
'Assign the criteria to the new_slSQL string using the textbox's
Tag property and the LIKE operator
new_slSQL = new_slSQL & sql_And_or_Where & slField.Tag & " LIKE
'*" & slField & "*' "
adjustOrderBy = True
End If
Next i
Select Case sl_Special_Field_Control_Name
Case "Nothing", ""
Case Else
Set slField = slForm(sl_Special_Field_Control_Name)
new_slSQL = new_slSQL & sql_And_or_Where & slField.Tag & " "
adjustOrderBy = True
Debug.Print new_slSQL
End Select
With slListbox
'.RowSource = new_slSQL & "ORDER BY " & slSQL_OrderBy
.RowSource = new_slSQL & "ORDER BY " & slSQL_OrderBy
.Requery
If .ListCount = 0 Then
slListCount_Label.Caption = .ListCount & _
" record" & IIf(.ListCount = 1, "", "s") & " listed."
Else
slListCount_Label.Caption = Format(.ListCount, "##,###") & _
" record" & IIf(.ListCount = 1, "", "s") & " listed."
End If
If .ListCount = 1 Then
.Selected(0) = True
Else
.Value = 0
End If
End With
If ActiveField_Set = True Then
ActiveField_Set_Block:
With slActiveField
If .ControlType = acTextBox Then
If .Enabled Then .SetFocus
If Not IsNull(slActiveField) Then
.SelStart = Len(slActiveField)
End If
If addSpace = True Then slActiveField = slActiveField & " "
If Not IsNull(slActiveField) Then
.SelStart = Len(slActiveField)
End If
End If
End With
Else
If sl_Current_Field <> 0 Then
Set slActiveField = slForm("txtSL" & sl_Current_Field)
GoTo ActiveField_Set_Block
Else
slForm("txtSL1").SetFocus
End If
End If
Exit Function
ErrHandler:
Select Case Err.number
Case 2185 'You cant reference a control unless the control has the
focus
Select Case err_2185_Flag
Case 1
GoTo skip_Block1
Case Else
Resume Next
End Select
End Select
MsgBox Err.Description
Resume Next
End Function
Dim i As Byte 'counter
Dim sql_And_or_Where As String 'Used to store the SQL word "AND" or
"WHERE",
'depending on whether or not the
existing SQL
'statement contains the word "AND".
Dim j As Integer 'another counter
Dim slField As Control 'A control variable representing the
search-list textbox
Dim new_slSQL As String 'Used to store the SQL string for
later use
Dim criteriaFound As Boolean
Dim ActiveField_Set As Boolean
Dim k As Integer 'another counter
Dim slCriteria_Field() As String
Dim addSpace As Boolean 'for programmatically adding a space
to the search text, if it was entered
Dim adjustOrderBy As Boolean 'Adjust "ORDER BY" SQL
Dim err_2185_Flag As Byte 'used in error handling at the end
of this function
On Error GoTo ErrHandler
Select Case whichField 'whichField variable is the number
of the active
'search text box, for example:
"Company Name" = 2
Case sl_Initialize 'sl_Initialize constant is for
nullifying all
'search-list text boxes.
For i = 1 To slFieldLimit 'slFieldLimit is assigned when the
search screen
'loads for the first time. For
Example:
'Client Search form has slFieldLimit
of 8
slForm("txtSL" & i) = Null 'Nullify each search-list
text box.
Next i
Case Else
If whichField <> 0 Then
If slActiveField.ControlType = acTextBox Then
'slActiveField is set when the textbox receives the focus
err_2185_Flag = 1 'This
flag is used in error handling at the end of this function
If Right(slActiveField.Text, 1) = " " Then ' if a space
was entered
addSpace = True
End If
skip_Block1:
End If
End If
End Select
slForm("SF").SetFocus 'slForm is the form object set to the search
form (example: "Admin")
'"SF" is a textbox that receives the focus
at times when nothing else should
'receive the focus.
new_slSQL = slSQL 'This variable holds the SQL string and is
used to recontruct it.
sql_And_or_Where = " WHERE " 'The default assignment to this string
variable is " WHERE " because
'that is what is used at the first
firing of this function. It is later
'changed to " AND " when more search
criteria is entered in other text boxes.
For i = 1 To slFieldLimit 'Loop through each search field
For j = 1 To Len(new_slSQL) 'Loop through each character of the
SQL string
If Mid(new_slSQL, j, 5) = "WHERE" Then 'If the word "WHERE"
is found in the SQL string
sql_And_or_Where = " AND " 'Change the variable
value to " AND "
Exit For 'Exit Loop
End If
Next j
Set slField = slForm("txtSL" & i) 'Set the slField to
the specific textbox analyzed at this i
If Nz(slField, "") <> "" Then 'If the value of
slField is not nothing
'Assign the criteria to the new_slSQL string using the textbox's
Tag property and the LIKE operator
new_slSQL = new_slSQL & sql_And_or_Where & slField.Tag & " LIKE
'*" & slField & "*' "
adjustOrderBy = True
End If
Next i
Select Case sl_Special_Field_Control_Name
Case "Nothing", ""
Case Else
Set slField = slForm(sl_Special_Field_Control_Name)
new_slSQL = new_slSQL & sql_And_or_Where & slField.Tag & " "
adjustOrderBy = True
Debug.Print new_slSQL
End Select
With slListbox
'.RowSource = new_slSQL & "ORDER BY " & slSQL_OrderBy
.RowSource = new_slSQL & "ORDER BY " & slSQL_OrderBy
.Requery
If .ListCount = 0 Then
slListCount_Label.Caption = .ListCount & _
" record" & IIf(.ListCount = 1, "", "s") & " listed."
Else
slListCount_Label.Caption = Format(.ListCount, "##,###") & _
" record" & IIf(.ListCount = 1, "", "s") & " listed."
End If
If .ListCount = 1 Then
.Selected(0) = True
Else
.Value = 0
End If
End With
If ActiveField_Set = True Then
ActiveField_Set_Block:
With slActiveField
If .ControlType = acTextBox Then
If .Enabled Then .SetFocus
If Not IsNull(slActiveField) Then
.SelStart = Len(slActiveField)
End If
If addSpace = True Then slActiveField = slActiveField & " "
If Not IsNull(slActiveField) Then
.SelStart = Len(slActiveField)
End If
End If
End With
Else
If sl_Current_Field <> 0 Then
Set slActiveField = slForm("txtSL" & sl_Current_Field)
GoTo ActiveField_Set_Block
Else
slForm("txtSL1").SetFocus
End If
End If
Exit Function
ErrHandler:
Select Case Err.number
Case 2185 'You cant reference a control unless the control has the
focus
Select Case err_2185_Flag
Case 1
GoTo skip_Block1
Case Else
Resume Next
End Select
End Select
MsgBox Err.Description
Resume Next
End Function