Rubtime error 2501 (1 Viewer)

[kadara]

Runtime error 2501

Hi,
I have a report filtered by date (between 2 dates). I put the following NoData event:

Private Sub Report_NoData(Cancel As Integer)
' Display a message if user enters a date for which there are no records,
' and don't preview or print report.
    Dim strMsg As String, strTitle As String
    Dim intStyle As Integer
 
    strMsg = "There is no records!"
    intStyle = vbOKOnly
    strTitle = "No Data for Date Range"
 
    MsgBox strMsg, intStyle, strTitle
    Cancel = True
End Sub

I have created a Switchboard (with the Switchboard Manager) to open the report.
If there is no records between the 2 dates, the messagebox (with the "There is no records" message) is activated, and after that I get "Run-time error '2501': The OpenReport action was cancelled" error message.
There is the code using for the switchboard:

Option Compare Database
Option Explicit

Private Sub Form_Open(Cancel As Integer)
' Minimize the database window and initialize the form.
' Move to the switchboard page that is marked as the default.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.FilterOn = True

End Sub

Private Sub Form_Current()
' Update the caption and fill in the list of options.
Me.Caption = Nz(Me![ItemText], "")
Me.lblLabel.Caption = Nz(Me![ItemText], "")
FillOptions

End Sub

Private Sub FillOptions()
' Fill in the options for this switchboard page.
' The number of buttons on the form.
Const conNumButtons = 8

Dim con As Object
Dim rs As Object
Dim stSql As String
Dim intOption As Integer

' Set the focus to the first button on the form,
' and then hide all of the buttons on the form
' but the first. You can't hide the field with the focus.
Me![Option1].SetFocus
For intOption = 2 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).Visible = False
Next intOption

' Open the table of Switchboard Items, and find
' the first item for this Switchboard Page.
Set con = Application.CurrentProject.Connection
stSql = "SELECT * FROM [Switchboard Items]"
stSql = stSql & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]
stSql = stSql & " ORDER BY [ItemNumber];"
Set rs = CreateObject("ADODB.Recordset")
rs.Open stSql, con, 1 ' 1 = adOpenKeyset

' If there are no options for this Switchboard Page,
' display a message. Otherwise, fill the page with the items.
If (rs.EOF) Then
Me![OptionLabel1].Caption = "There are no items for this switchboard page"
Else
While (Not (rs.EOF))
Me("Option" & rs![ItemNumber]).Visible = True
Me("OptionLabel" & rs![ItemNumber]).Visible = True
Me("OptionLabel" & rs![ItemNumber]).Caption = rs![ItemText]
rs.MoveNext
Wend
End If
' Close the recordset and the database.
rs.Close
Set rs = Nothing
Set con = Nothing
End Sub

Private Function HandleButtonClick(intBtn As Integer)
' This function is called when a button is clicked.
' intBtn indicates which button was clicked.
' Constants for the commands that can be executed.
Const conCmdGotoSwitchboard = 1
Const conCmdOpenFormAdd = 2
Const conCmdOpenFormBrowse = 3
Const conCmdOpenReport = 4
Const conCmdCustomizeSwitchboard = 5
Const conCmdExitApplication = 6
Const conCmdRunMacro = 7
Const conCmdRunCode = 8
Const conCmdOpenPage = 9
' An error that is special cased.
Const conErrDoCmdCancelled = 2501

Dim con As Object
Dim rs As Object
Dim stSql As String
On Error GoTo HandleButtonClick_Err
' Find the item in the Switchboard Items table
' that corresponds to the button that was clicked.
Set con = Application.CurrentProject.Connection
Set rs = CreateObject("ADODB.Recordset")
stSql = "SELECT * FROM [Switchboard Items] "
stSql = stSql & "WHERE [SwitchboardID]=" & Me![SwitchboardID] & " AND [ItemNumber]=" & intBtn
rs.Open stSql, con, 1 ' 1 = adOpenKeyset

' If no item matches, report the error and exit the function.
If (rs.EOF) Then
MsgBox "There was an error reading the Switchboard Items table."
rs.Close
Set rs = Nothing
Set con = Nothing
Exit Function
End If

'If Not (conCmdOpenReport) Then
' Exit Function
'End If

Select Case rs![Command]

' Go to another switchboard.
Case conCmdGotoSwitchboard
Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=" & rs![Argument]

' Open a form in Add mode.
Case conCmdOpenFormAdd
DoCmd.OpenForm rs![Argument], , , , acAdd
' Open a form.
Case conCmdOpenFormBrowse
DoCmd.OpenForm rs![Argument]
' Open a report.
Case conCmdOpenReport
DoCmd.OpenReport rs![Argument], acPreview
' Customize the Switchboard.
Case conCmdCustomizeSwitchboard
' Handle the case where the Switchboard Manager
' is not installed (e.g. Minimal Install).
On Error Resume Next
Application.Run "ACWZMAIN.sbm_Entry"
If (Err <> 0) Then MsgBox "Command not available."
On Error GoTo 0
' Update the form.
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.Caption = Nz(Me![ItemText], "")
FillOptions
' Exit the application.
Case conCmdExitApplication
CloseCurrentDatabase
' Run a macro.
Case conCmdRunMacro
DoCmd.RunMacro rs![Argument]
' Run code.
Case conCmdRunCode
Application.Run rs![Argument]
' Open a Data Access Page
Case conCmdOpenPage
DoCmd.OpenDataAccessPage rs![Argument]
' Any other command is unrecognized.
Case Else
MsgBox "Unknown option."

End Select
' Close the recordset and the database.
rs.Close

HandleButtonClick_Exit:
On Error Resume Next
Set rs = Nothing
Set con = Nothing
Exit Function
HandleButtonClick_Err:
' If the action was cancelled by the user for
' some reason, don't display an error message.
' Instead, resume on the next line.

If (Err = conErrDoCmdCancelled) Then
Resume Next
Else
MsgBox "There was an error executing the command.", vbCritical
Resume HandleButtonClick_Exit
End If

End Function

When I debug, the line of the code that I have in bold typeface is the line that is highlighted.

I have been at it for a while but I cannot figure out what is wrong. Please help.

Thanks in advance.

 

[JANR]

Just trap error 2501.

Put this in the next line of where the debugger stopped:

If Err.Number = 2501 Then Err.Clear

JR

 

[kadara]

There is no change. I get this error again.

...
' Open a report.
Case conCmdOpenReport
If Err.Number = 2501 Then Err.Clear
DoCmd.OpenReport rs![Argument], acPreview
...

 

[JANR]

I said After the line.

' Open a report.
Case conCmdOpenReport
DoCmd.OpenReport rs![Argument], acPreview
[B]If Err.Number = 2501 Then Err.Clear
[/B]

JR

 

[kadara]

Not working...

 

[RainLover]

kadara

Microsoft's Switchboard is a great tool for those who don't know how to code.

I would delete all Microsoft's code and replace it with my own.

After all you just want to open a Report.

Try using

stDocName = "Your Report Name"
DoCmd.OpenReport stDocName, acPreview

With this you can add your other code without errors.

 

[kadara]

Here is the simplified version of the db (I just removed the switchboard).
I can't fix the problem. If there are no records, I get the runtime error 2501 message.

 

[Pat Hartman]

The Switchbord Form has an error handler in this procedure. It should trap this error.

HandleButtonClick_Err:
    ' If the action was cancelled by the user for
    ' some reason, don't display an error message.
    ' Instead, resume on the next line.
    If (Err = conErrDoCmdCancelled) Then
        Resume Next
    Else
        MsgBox "There was an error executing the command.", vbCritical
        Resume HandleButtonClick_Exit
    End If

If you need to create your own. I suggest this method.

HandleButtonClick_Err:
    ' If the action was cancelled by the user for
    ' some reason, don't display an error message.
    ' Instead, resume on the next line.
    Select Case Err.Number
        Case 2501    'cancelled by user
            Resume Next
        Case Else
            MsgBox Err.Number & "--" & Err.Description, vbOKOnly
            Resume    HandleButtonClick_Exit
    End Select
End If