M
Michael
I have the following code triggered by a button click on a form. The code is
designed to search in a table and only retrieve the specific record or
records. What I am interested in doing is that right after that click, the
user will be visually notified of the number of total records found according
to the criteria entered to be retrieved. Preferably a message saying
something like, '5 accounts found'. Thanks!
---------------------------------------------------------------------
Option Compare Database
Private Sub Command19_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control
'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
End Select
Next
'Remove the form's filter.
Me.FilterOn = False
End Sub
Private Sub Command104_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control
'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
Case acCheckBox
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
ctl.value = False
End Select
Next
'Remove the form's filter.
Me.FilterOn = False
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
If Not IsNull(Me.txtFilteraccount) Then
Me.txtFilteraccount = Null
End If
If Not IsNull(Me.txtFiltercust) Then
Me.txtFiltercust = Null
End If
If Not IsNull(Me.txtFilterstnum) Then
Me.txtFilterstnum = Null
End If
If Not IsNull(Me.txtFilterstname) Then
Me.txtFilterstname = Null
End If
If Not IsNull(Me.txtFiltercity) Then
Me.txtFiltercity = Null
End If
End Sub
Private Sub Command9_Click()
'Purpose: Build up the criteria string form the non-blank search boxes,
and apply to the form's Filter.
'Notes: 1. We tack " AND " on the end of each condition so you can
easily add more search boxes; _
we remove the trailing " AND " at the end.
' 2. The date range works like this: _
Both dates = only dates between (both
inclusive. _
Start date only = all dates from this one onwards; _
End date only = all dates up to (and including
this one).
Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria string
to append to.
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for dates
in a JET query string.
If Not IsNull(Me.txtFiltercorp) Then
strWhere = strWhere & "([Corp] Like ""*" & Me.txtFiltercorp & "*"")
AND "
End If
If Not IsNull(Me.txtFilteraccount) Then
strWhere = strWhere & "([Account] Like ""*" & Me.txtFilteraccount &
"*"") AND "
End If
If Not IsNull(Me.txtFiltercust) Then
strWhere = strWhere & "([Customer] Like ""*" & Me.txtFiltercust &
"*"") AND "
End If
If Not IsNull(Me.txtFilterstnum) Then
strWhere = strWhere & "([StreetNum] Like ""*" & Me.txtFilterstnum &
"*"") AND "
End If
If Not IsNull(Me.txtFilterstname) Then
strWhere = strWhere & "([StreetName] Like ""*" & Me.txtFilterstname
& "*"") AND "
End If
If Not IsNull(Me.txtFiltercity) Then
strWhere = strWhere & "([City] Like ""*" & Me.txtFiltercity & "*"")
AND "
End If
'***********************************************************************
'Chop off the trailing " AND ", and use the string as the form's Filter.
'***********************************************************************
'See if the string has more than 5 characters (a trailng " AND ") to
remove.
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove the "
AND " at the end.
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line. Prints to
Immediate Window (Ctrl+G).
'Debug.Print strWhere
'Finally, apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer)
'To avoid problems if the filter returns no records, we did not set its
AllowAdditions to No.
'We prevent new records by cancelling the form's BeforeInsert event
instead.
'The problems are explained at http://allenbrowne.com/bug-06.html
Cancel = True
MsgBox "You cannot add new clients to the search form.", vbInformation,
"Permission denied."
End Sub
Private Sub Form_Open(Cancel As Integer)
'Remove the single quote from these lines if you want to initially show
no records.
Me.Filter = "(False)"
Me.FilterOn = True
End Sub
Private Sub Command22_Click()
On Error GoTo Err_Command22_Click
DoCmd.PrintOut
Exit_Command22_Click:
Exit Sub
Err_Command22_Click:
MsgBox Err.Description
Resume Exit_Command22_Click
End Sub
Private Sub Command25_Click()
On Error GoTo Err_Command25_Click
DoCmd.Close
Exit_Command25_Click:
Exit Sub
Err_Command25_Click:
MsgBox Err.Description
Resume Exit_Command25_Click
End Sub
Private Sub Command29_Click()
On Error GoTo Err_Command29_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 2, , acMenuVer70
Exit_Command29_Click:
Exit Sub
Err_Command29_Click:
MsgBox Err.Description
Resume Exit_Command29_Click
End Sub
Private Sub Command44_Click()
On Error GoTo Err_Command44_Click
DoCmd.GoToRecord , , acNewRec
Exit_Command44_Click:
Exit Sub
Err_Command44_Click:
MsgBox Err.Description
Resume Exit_Command44_Click
End Sub
Private Sub Command47_Click()
On Error GoTo Err_Command47_Click
Dim stDocName As String
stDocName = "Query1"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Exit_Command47_Click:
Exit Sub
Err_Command47_Click:
MsgBox Err.Description
Resume Exit_Command47_Click
End Sub
Private Sub Command86_Click()
On Error GoTo Err_Command86_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Exit_Command86_Click:
Exit Sub
Err_Command86_Click:
MsgBox Err.Description
Resume Exit_Command86_Click
End Sub
----------------------------------------------------------------------------
designed to search in a table and only retrieve the specific record or
records. What I am interested in doing is that right after that click, the
user will be visually notified of the number of total records found according
to the criteria entered to be retrieved. Preferably a message saying
something like, '5 accounts found'. Thanks!
---------------------------------------------------------------------
Option Compare Database
Private Sub Command19_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control
'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
End Select
Next
'Remove the form's filter.
Me.FilterOn = False
End Sub
Private Sub Command104_Click()
'Purpose: Clear all the search boxes in the Form Header, and show all
records again.
Dim ctl As Control
'Clear all the controls in the Form Header section.
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acTextBox, acComboBox
Case acCheckBox
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
ctl.value = False
End Select
Next
'Remove the form's filter.
Me.FilterOn = False
If Not IsNull(Me.txtFiltercorp) Then
Me.txtFiltercorp = Null
End If
If Not IsNull(Me.txtFilteraccount) Then
Me.txtFilteraccount = Null
End If
If Not IsNull(Me.txtFiltercust) Then
Me.txtFiltercust = Null
End If
If Not IsNull(Me.txtFilterstnum) Then
Me.txtFilterstnum = Null
End If
If Not IsNull(Me.txtFilterstname) Then
Me.txtFilterstname = Null
End If
If Not IsNull(Me.txtFiltercity) Then
Me.txtFiltercity = Null
End If
End Sub
Private Sub Command9_Click()
'Purpose: Build up the criteria string form the non-blank search boxes,
and apply to the form's Filter.
'Notes: 1. We tack " AND " on the end of each condition so you can
easily add more search boxes; _
we remove the trailing " AND " at the end.
' 2. The date range works like this: _
Both dates = only dates between (both
inclusive. _
Start date only = all dates from this one onwards; _
End date only = all dates up to (and including
this one).
Dim strWhere As String 'The criteria string.
Dim lngLen As Long 'Length of the criteria string
to append to.
Const conJetDate = "\#mm\/dd\/yyyy\#" 'The format expected for dates
in a JET query string.
If Not IsNull(Me.txtFiltercorp) Then
strWhere = strWhere & "([Corp] Like ""*" & Me.txtFiltercorp & "*"")
AND "
End If
If Not IsNull(Me.txtFilteraccount) Then
strWhere = strWhere & "([Account] Like ""*" & Me.txtFilteraccount &
"*"") AND "
End If
If Not IsNull(Me.txtFiltercust) Then
strWhere = strWhere & "([Customer] Like ""*" & Me.txtFiltercust &
"*"") AND "
End If
If Not IsNull(Me.txtFilterstnum) Then
strWhere = strWhere & "([StreetNum] Like ""*" & Me.txtFilterstnum &
"*"") AND "
End If
If Not IsNull(Me.txtFilterstname) Then
strWhere = strWhere & "([StreetName] Like ""*" & Me.txtFilterstname
& "*"") AND "
End If
If Not IsNull(Me.txtFiltercity) Then
strWhere = strWhere & "([City] Like ""*" & Me.txtFiltercity & "*"")
AND "
End If
'***********************************************************************
'Chop off the trailing " AND ", and use the string as the form's Filter.
'***********************************************************************
'See if the string has more than 5 characters (a trailng " AND ") to
remove.
lngLen = Len(strWhere) - 5
If lngLen <= 0 Then 'Nah: there was nothing in the string.
MsgBox "No criteria", vbInformation, "Nothing to do."
Else 'Yep: there is something there, so remove the "
AND " at the end.
strWhere = Left$(strWhere, lngLen)
'For debugging, remove the leading quote on the next line. Prints to
Immediate Window (Ctrl+G).
'Debug.Print strWhere
'Finally, apply the string as the form's Filter.
Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub
Private Sub Form_BeforeInsert(Cancel As Integer)
'To avoid problems if the filter returns no records, we did not set its
AllowAdditions to No.
'We prevent new records by cancelling the form's BeforeInsert event
instead.
'The problems are explained at http://allenbrowne.com/bug-06.html
Cancel = True
MsgBox "You cannot add new clients to the search form.", vbInformation,
"Permission denied."
End Sub
Private Sub Form_Open(Cancel As Integer)
'Remove the single quote from these lines if you want to initially show
no records.
Me.Filter = "(False)"
Me.FilterOn = True
End Sub
Private Sub Command22_Click()
On Error GoTo Err_Command22_Click
DoCmd.PrintOut
Exit_Command22_Click:
Exit Sub
Err_Command22_Click:
MsgBox Err.Description
Resume Exit_Command22_Click
End Sub
Private Sub Command25_Click()
On Error GoTo Err_Command25_Click
DoCmd.Close
Exit_Command25_Click:
Exit Sub
Err_Command25_Click:
MsgBox Err.Description
Resume Exit_Command25_Click
End Sub
Private Sub Command29_Click()
On Error GoTo Err_Command29_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 2, , acMenuVer70
Exit_Command29_Click:
Exit Sub
Err_Command29_Click:
MsgBox Err.Description
Resume Exit_Command29_Click
End Sub
Private Sub Command44_Click()
On Error GoTo Err_Command44_Click
DoCmd.GoToRecord , , acNewRec
Exit_Command44_Click:
Exit Sub
Err_Command44_Click:
MsgBox Err.Description
Resume Exit_Command44_Click
End Sub
Private Sub Command47_Click()
On Error GoTo Err_Command47_Click
Dim stDocName As String
stDocName = "Query1"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Exit_Command47_Click:
Exit Sub
Err_Command47_Click:
MsgBox Err.Description
Resume Exit_Command47_Click
End Sub
Private Sub Command86_Click()
On Error GoTo Err_Command86_Click
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Exit_Command86_Click:
Exit Sub
Err_Command86_Click:
MsgBox Err.Description
Resume Exit_Command86_Click
End Sub
----------------------------------------------------------------------------