D
DeDBlanK
In advance me.help = grateful AND thankful =P
I am having an issue with some code. I am trying to do a dcount on
records verifying that there are records before opening the report (in
other words, handle it in the dialog and not the reports No Data
event)
This code works without the DCount (have commented in the code)
'****CODE START****
Private Sub cmdReport_Click()
'Remove the single quote from start of next line once you have it
working.
'On Error GoTo Err_Handler
'Purpose: Filter a report to a date range.
'Documentation: http://allenbrowne.com/casu-08.html
'Note: Filter uses "less than the next day" in case the field has a
time component.
Dim strReport As String
Dim strDateField As String
Dim varWhere As Variant
Dim lngView As Integer
Dim msg As String
Dim strRecordSource As String
Const strcJetDate = "\#mm\/dd\/yyyy\#"
'DO set the CASE values.
Select Case Me.Frame18.Value
Case 1
strReport = "rptDetailRepair" 'Put your report name in
these quotes.
Case 2
strReport = "rptSummaryQAD"
Case 3
strReport = "rptSummaryReport"
Case 4
strReport = "rptSummaryReportRepair"
Case 5
strReport = "rptSummaryDateRangeDowntime"
Case 6
strReport = "rptSQCDMonthly"
Case 7
strReport = "rptOEE"
Case Null
msg = "value is null"
MsgBox msg, vbInformation, "No Report"
GoTo Exit_Handler
Case Else
msg = "No report selected"
MsgBox msg, vbInformation, "No Report"
GoTo Exit_Handler
End Select
strDateField = "[dtmDate]" 'Put your field name in the square
brackets in these quotes.
lngView = acViewPreview 'Use acViewNormal to print instead of
preview.
varWhere = Null 'Set to null to check later if value
has been assigned
'Build the filter string.
If IsDate(Me.txtStartDate) Then
varWhere = "(" & strDateField & " >= " &
Format(Me.txtStartDate, strcJetDate) & ")"
End If
'I like to use the DateValue function to strip times from date/
time Fields
If IsDate(Me.txtEndDate) Then 'Check if start date had a value,
if so add AND and end date
If varWhere <> vbNullString Then
varWhere = (varWhere + " AND ") & "(DateValue(" &
strDateField & ")<= " & Format(Me.txtEndDate, strcJetDate) & ")"
Else ' just add end date
varWhere = "(DateValue(" & strDateField & ")<= " &
Format(Me.txtEndDate, strcJetDate) & ")"
End If
End If
'build filter string for Shift
varWhere = (varWhere + " AND ") & "([strShift]" &
fnMultiList(Me.lstShift) & ")"
'build filter string for Dept
If Me.lstDept.ItemsSelected.Count >= 1 Then
varWhere = (varWhere + " AND ") & "([fkLine]" &
fnMultiList(Me.lstDept) & ")"
End If
'Close the report if already open: otherwise it won't filter
properly.
If CurrentProject.AllReports(strReport).IsLoaded Then
DoCmd.Close acReport, strReport
End If
'******CODE ISSUE*****
'check for records in the report
DoCmd.OpenReport strReport, acViewDesign, , varWhere, acHidden
strRecordSource = Reports(strReport).recordsource
If DCount("*", strRecordSource, varWhere) > 0 Then
'Open the report. ****THIS SECTION WORKS****
Debug.Print DCount("*", strRecordSource, varWhere)
Debug.Print varWhere
DoCmd.OpenReport strReport, lngView, , varWhere
'*****END THIS SECTION WORKS*******
Else
'Close report with message
msg = "Sorry, Unable to find data that matches that criteria"
MsgBox msg, vbExclamation, "No Data"
DoCmd.Close acReport, strReport, acSaveNo
End If
'***END CODE ISSUE****
Exit_Handler:
Exit Sub
Err_Handler:
If Err.Number <> 2501 Then
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbExclamation, "Cannot open report"
End If
Resume Exit_Handler
End Sub
'****CODE END****
I am having an issue with some code. I am trying to do a dcount on
records verifying that there are records before opening the report (in
other words, handle it in the dialog and not the reports No Data
event)
This code works without the DCount (have commented in the code)
'****CODE START****
Private Sub cmdReport_Click()
'Remove the single quote from start of next line once you have it
working.
'On Error GoTo Err_Handler
'Purpose: Filter a report to a date range.
'Documentation: http://allenbrowne.com/casu-08.html
'Note: Filter uses "less than the next day" in case the field has a
time component.
Dim strReport As String
Dim strDateField As String
Dim varWhere As Variant
Dim lngView As Integer
Dim msg As String
Dim strRecordSource As String
Const strcJetDate = "\#mm\/dd\/yyyy\#"
'DO set the CASE values.
Select Case Me.Frame18.Value
Case 1
strReport = "rptDetailRepair" 'Put your report name in
these quotes.
Case 2
strReport = "rptSummaryQAD"
Case 3
strReport = "rptSummaryReport"
Case 4
strReport = "rptSummaryReportRepair"
Case 5
strReport = "rptSummaryDateRangeDowntime"
Case 6
strReport = "rptSQCDMonthly"
Case 7
strReport = "rptOEE"
Case Null
msg = "value is null"
MsgBox msg, vbInformation, "No Report"
GoTo Exit_Handler
Case Else
msg = "No report selected"
MsgBox msg, vbInformation, "No Report"
GoTo Exit_Handler
End Select
strDateField = "[dtmDate]" 'Put your field name in the square
brackets in these quotes.
lngView = acViewPreview 'Use acViewNormal to print instead of
preview.
varWhere = Null 'Set to null to check later if value
has been assigned
'Build the filter string.
If IsDate(Me.txtStartDate) Then
varWhere = "(" & strDateField & " >= " &
Format(Me.txtStartDate, strcJetDate) & ")"
End If
'I like to use the DateValue function to strip times from date/
time Fields
If IsDate(Me.txtEndDate) Then 'Check if start date had a value,
if so add AND and end date
If varWhere <> vbNullString Then
varWhere = (varWhere + " AND ") & "(DateValue(" &
strDateField & ")<= " & Format(Me.txtEndDate, strcJetDate) & ")"
Else ' just add end date
varWhere = "(DateValue(" & strDateField & ")<= " &
Format(Me.txtEndDate, strcJetDate) & ")"
End If
End If
'build filter string for Shift
varWhere = (varWhere + " AND ") & "([strShift]" &
fnMultiList(Me.lstShift) & ")"
'build filter string for Dept
If Me.lstDept.ItemsSelected.Count >= 1 Then
varWhere = (varWhere + " AND ") & "([fkLine]" &
fnMultiList(Me.lstDept) & ")"
End If
'Close the report if already open: otherwise it won't filter
properly.
If CurrentProject.AllReports(strReport).IsLoaded Then
DoCmd.Close acReport, strReport
End If
'******CODE ISSUE*****
'check for records in the report
DoCmd.OpenReport strReport, acViewDesign, , varWhere, acHidden
strRecordSource = Reports(strReport).recordsource
If DCount("*", strRecordSource, varWhere) > 0 Then
'Open the report. ****THIS SECTION WORKS****
Debug.Print DCount("*", strRecordSource, varWhere)
Debug.Print varWhere
DoCmd.OpenReport strReport, lngView, , varWhere
'*****END THIS SECTION WORKS*******
Else
'Close report with message
msg = "Sorry, Unable to find data that matches that criteria"
MsgBox msg, vbExclamation, "No Data"
DoCmd.Close acReport, strReport, acSaveNo
End If
'***END CODE ISSUE****
Exit_Handler:
Exit Sub
Err_Handler:
If Err.Number <> 2501 Then
MsgBox "Error " & Err.Number & ": " & Err.Description,
vbExclamation, "Cannot open report"
End If
Resume Exit_Handler
End Sub
'****CODE END****