CODEWITHSUNDEEP
vbaexcel
Akshay
Akshay

Reputation: 47

If there is no attachment file is present at path mail should not send

If there is no attachment file is present at path mail should not send.

Is there any possibility that mail should not be send if there is no attachment?

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = " Hello"
On Error Resume Next
With OutMail
    .to = "[email protected]"
    .cc = "[email protected]"
    .BCC = ""
    .Subject = "TRANSACTING : " & Format(Date, "DD-MMM-YYYY")
    .HTMLBody = strbody
    'You can add an attachment like this
    .Attachments.Add ("E:\Auto Reports\test.xlsb")
    .send   'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Upvotes: 2

Views: 4046

Answers (2)

Pᴇʜ
Pᴇʜ

Reputation: 57683

First of all using On Error Resume Next in the way you did just mute any errors. But the errors still occur they just don't show. Using On Error Resume Next is a very bad practice and you should avoid that unless you really know why you need to do it.

Instead you should always implement a proper error handling like below. Now the error is shown if adding an attachment to the email fails and the email is not sent.

Option Explicit

Public Sub SendMyEMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = " Hello"

    On Error GoTo MAIL_ERROR 'jump to the error handler if an error occurs
        With OutMail
            .to = "[email protected]"
            .cc = "[email protected]"
            .BCC = ""
            .Subject = "TRANSACTING : " & Format(Date, "DD-MMM-YYYY")
            .HTMLBody = strbody
            'You can add an attachment like this
            .Attachments.Add ("C:\Auto Reports\test.xlsb")
            .send   'or use .Display
        End With
    On Error GoTo 0 'stop error handling here (no jumps to the error handler anymore.

    'The following 2 lines can be omitted because it is done automatically on exit sub
    'So these are completely unnecessary.
      'Set OutMail = Nothing 
      'Set OutApp = Nothing

    Exit Sub 'we need this to not to run into error handler if everything was ok

MAIL_ERROR: 'Show error message
    MsgBox "An error occured during sending the email. The email was not sent: " & vbNewLine & Err.Description, vbCritical, "Error " & Err.Number, Err.HelpFile, Err.HelpContext
End Sub

Send multiple different e-mails

To send multiple different e-mails you need to make your procedure a more universal function receiving some parameters. 

Public Function SendMyEMail(MailTo As String, MailCC As String, MailSubject As String, MailFileName As String)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    strbody = " Hello"

    On Error GoTo MAIL_ERROR 'jump to the error handler if an error occurs
        With OutMail
            .To = MailTo
            .CC = MailCC
            .BCC = ""
            .Subject = MailSubject
            .HTMLBody = strbody
            'You can add an attachment like this
            .Attachments.Add MailFileName
            .send   'or use .Display
        End With
    On Error GoTo 0 'stop error handling here (no jumps to the error handler anymore.

    'The following 2 lines can be omitted because it is done automatically on exit sub
    'So these are completely unnecessary.
      'Set OutMail = Nothing
      'Set OutApp = Nothing

    Exit Function 'we need this to not to run into error handler if everything was ok

MAIL_ERROR:     'Show error message
    MsgBox "An error occured during sending the email. The email was not sent: " & vbNewLine & Err.Description, vbCritical, "Error " & Err.Number, Err.HelpFile, Err.HelpContext
End Function

And a procedure SendMultipleEmails looping through a worksheet and run SendMyEMail for every row.

Public Sub SendMultipleEmails()
    Dim wsMail As Worksheet
    Set wsMail = Worksheets("MyMailSheet")

    Dim iRow As Long, lRow As Long
    lRow = wsMail.Cells(wsMail.Rows.Count, "A").End(xlUp).Row 'find last used row in column A

    For iRow = 1 To lRow 'run from first to last used row
        SendMyEMail wsMail.Cells(i, "A"), wsMail.Cells(i, "B"), wsMail.Cells(i, "C"), wsMail.Cells(i, "D")
        'SendMyEMail for every row in that sheet where MailTo is in column A, MailCC is in column B, …
    Next iRow
End Sub

Upvotes: 2

Kostas K.
Kostas K.

Reputation: 8518

You can check if the file exists before attempting to draft the email.

Sub SendEmail()

    'Exit if file does not exist
    If Len(Dir("E:\Auto Reports\test.xlsb", vbDirectory)) = 0 Then Exit Sub

    'Proceed
    Dim OutApp As Object

    'rest of code
End Sub

Upvotes: 0

Related Questions