the open report action was canceled error 2501

[siamandm]

Hello all
I'm using a form to filter data and show the result on the report
when there is no data, I get a pop-up notification no data, and when I click OK I get this error below :

runtime error 2501.jpg

Code: Select all

Private Sub cmdExportExcel_Click()


    Const strTemp = "TempQuery" ' or whatever you like
    Dim dbs As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim strSQL As String
    Dim strWhere As String
    Dim strFilePath As String
    Dim strEmployeeName As String
   
   
    If IsNull(Me.cboEmployeeFullName) Then
        Me.cboEmployeeFullName.SetFocus
        MsgBox "Please select an employee, then try again.", vbExclamation
        Exit Sub
    End If
    ' Assemble strSQL
    strSQL = "SELECT * FROM qryCalc"
    strWhere = GetWhere
    If strWhere <> "" Then
     strEmployeeName = Me.cboEmployeeFullName.Column(1)
     strFilePath = "C:\Users\" & Environ("username") & "\Documents\"
        strSQL = strSQL & " WHERE " & strWhere
         
    End If
    ' Create a new temporary query with the SQL string
    Set dbs = CurrentDb
    Set qdf = dbs.CreateQueryDef(Name:=strTemp, SQLText:=strSQL)
    ' Export the temporary query to Excel
    DoCmd.TransferSpreadsheet TransferType:=acExport, _
        SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
        TableName:=strTemp, _
        FileName:=strFilePath & strEmployeeName & ".xlsx"
    ' Delete the temporary query
    dbs.QueryDefs.Delete strTemp
    
    
End Sub

Private Sub cmdPrtRpt_Click()
If IsNull(Me.cboEmployeeFullName) Then
        Me.cboEmployeeFullName.SetFocus
        MsgBox "Please select an employee, then try again.", vbExclamation
        Exit Sub
    End If
    DoCmd.OpenReport REPORTNAME:="rptEmployee", View:=acViewReport, WhereCondition:=GetWhere
End Sub

Private Function GetWhere() As String
    Dim strWhere As String
    If Not IsNull(Me.cboEmployeeFullName) Then
        strWhere = " AND EmployeeFullName = '" & Me.cboEmployeeFullName.Column(1) & "'"
        
    End If
    If Not IsNull(Me.txtStartDate) Then
        strWhere = strWhere & " AND WorkingDate>=#" & Format(Me.txtStartDate, "mm/dd/yyyy") & "#"
    End If
    If Not IsNull(Me.txtEndDate) Then
        strWhere = strWhere & " AND WorkingDate<=#" & Format(Me.txtEndDate, "mm/dd/yyyy") & "#"
    End If
    If strWhere <> "" Then
        GetWhere = Mid(strWhere, 6)
       
        
    End If
End Function

[HansV]

Change cmdPrtRpt_Click as follows:

Code: Select all

Private Sub cmdPrtRpt_Click()
    If IsNull(Me.cboEmployeeFullName) Then
        Me.cboEmployeeFullName.SetFocus
        MsgBox "Please select an employee, then try again.", vbExclamation
        Exit Sub
    End If
    On Error GoTo ErrHandler
    DoCmd.OpenReport ReportName:="rptEmployee", View:=acViewReport, WhereCondition:=GetWhere
    Exit Sub
ErrHandler:
    If Err.Number = 2501 Then
        ' Report was canceled, that's OK
    Else
        ' Other error
        MsgBox Err.Description, vbExclamation
    End If
End Sub

[siamandm]

thank you very much it worked!

Regards