Solved stop error message after aborting e-mail (1 Viewer)

[rainbows]

Private Sub cboReports_AfterUpdate()

 Dim strCriteria As String
    Dim thisCriteria As String
    Dim eMail As String
    Dim Title As String
    Dim Message As String
    Dim i As Integer
    DoCmd.OpenForm FormName:="ReportDialog", WindowMode:=acDialog
    '* check if [TextReportOption] <> 0
    If Me.TextReportOption <> 0 Then
        strCriteria = "(1=1)" '(1=1) means it is always True, therefore returns all records
        Select Case Me.TextReportOption
        Case Is = 1 'Print Preview
            '* Open the report with criteria
            DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewReport, WhereCondition:=strCriteria
        Case Is = 2 'Print
            '* Open the report with criteria
                  
                                                  
           DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewNormal, WhereCondition:=strCriteria
        Case Is = 3 'Email report
        
           If cboReports = cboReports Then
          
            
                         eMail = [Forms]![Issue List]![Text310]    '* close report if already open
                            If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
                            DoCmd.Close acReport, cboReports.Value
                            End If
                         '   DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WhereCondition:=thisCriteria
                            '* this is a test
                           '  DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
                            DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, eMail, , , cboReports, _
                                "Your prompt action is required for the following issues!"
                            DoCmd.Close acReport, cboReports.Value
                           ' .MoveNext
                        'Wend
                    ' End With
                    End If
                  
                    End Select
                    End If
                    
                
          
    
End Sub

hi . this is the error message get after I decide to abort an e.mail . could you please advise how to stop this

thanks steve

 

[Gasman]

Test for it in the error section and ignore it ?
You do not have one at present?, so add one. Then use On Error GoTo

 

[arnelgp]

add error handler to your code:

Private Sub cboReports_AfterUpdate()

Dim strCriteria As String
On Error Goto Err_Handler
    Dim thisCriteria As String
    Dim eMail As String
    Dim Title As String
    Dim Message As String
    Dim i As Integer
    DoCmd.OpenForm FormName:="ReportDialog", WindowMode:=acDialog
    '* check if [TextReportOption] <> 0
    If Me.TextReportOption <> 0 Then
        strCriteria = "(1=1)" '(1=1) means it is always True, therefore returns all records
        Select Case Me.TextReportOption
        Case Is = 1 'Print Preview
            '* Open the report with criteria
            DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewReport, WhereCondition:=strCriteria
        Case Is = 2 'Print
            '* Open the report with criteria
                 
                                                 
           DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewNormal, WhereCondition:=strCriteria
        Case Is = 3 'Email report
       
           If cboReports = cboReports Then
         
           
                         eMail = [Forms]![Issue List]![Text310]    '* close report if already open
                            If SysCmd(acSysCmdGetObjectState, acReport, cboReports.Value) <> 0 Then
                            DoCmd.Close acReport, cboReports.Value
                            End If
                         '   DoCmd.OpenReport REPORTNAME:=cboReports, VIEW:=acViewPreview, WhereCondition:=thisCriteria
                            '* this is a test
                           '  DoCmd.OutputTo acOutputReport, cboReports.Value, acFormatPDF, Environ("userprofile") & "\documents\rpt" & i & ".pdf", True
                            DoCmd.SendObject acSendReport, cboReports.Value, acFormatPDF, eMail, , , cboReports, _
                                "Your prompt action is required for the following issues!"
                            DoCmd.Close acReport, cboReports.Value
                           ' .MoveNext
                        'Wend
                    ' End With
                    End If
                 
                    End Select
                    End If
                   
Exit_Sub:
    Exit Sub
Err_Handler:
If Err.Number <> 2501 Then
    Msgbox Err.Number & vbCrLf & Err.Description
End If
    Resume Exit_Sub
         
   
End Sub

 

[rainbows]

thank you for your help , working great now