Send only those emails that have attachments by way of a VBA code

问题

I've just started working on macros and have made a pretty decent progress so far.

However, I'm stuck in a place and can't find an answer to it.

I'm using a macro to send emails to specific recipients via outlook. I'm sending multiple excel & pdf attachments in each email.

The code works fantastic! I, nonetheless, need to add a condition wherein an email that doesn't have any EXCEL attachments isn't sent and the outlook create mail item for this specific case only closes automatically.

The rest of the macro should continue for other clients with the excel attachments.

Hoping for someone to help me on this. Following is the code that I'm currently using.

Sub SendEmailWithReview_R()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim X As Long

    Lastrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

    For X = 10 To Lastrow
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olmailitem)

        With OutMail
            .To = Cells(X, 4)
            .CC = Cells(X, 6)
            .Subject = Cells(X, 8)
            .Body = Cells(1, 8)

            strlocation = "C:\Users\HKhan\Desktop\Final Macro\" & Cells(X, 1) & "-OICR.xlsx"
            On Error Resume Next
            .Attachments.Add (strlocation)
            On Error Resume Next
            strlocation = "C:\Users\HKhan\Desktop\Final Macro\" & Cells(X, 1) & "-OICLR.xlsx"
            On Error Resume Next
            .Attachments.Add (strlocation)
            On Error Resume Next
            strlocation = "C:\Users\HKhan\Desktop\Final Macro\" & "OIC - Bank Details" & ".pdf"
            On Error Resume Next
            .Attachments.Add (strlocation)
            On Error Resume Next
            strlocation = "C:\Users\HKhan\Desktop\Final Macro\" & "OICL - Bank Details" & ".pdf"
            On Error Resume Next
            .Attachments.Add (strlocation)
            On Error Resume Next
            .Display
            'send
        End With  
    Next X
End Sub

回答1:

So instead of waiting for errors or trying to suppress them better check if the file exists. Therefore you can use a function like this, which returns true if a file exists:

Public Function FileExists(FilePath As String) As Boolean
    Dim Path As String

    On Error Resume Next
    Path = Dir(FilePath)
    On Error GoTo 0

    If Path <> vbNullString Then FileExists = True
End Function

For adding attachments I recommend to use an array for the file names, so you can easily loop through and attach the files if they exist. Everytime we add an attachment we increase the AttachedFilesCount too.

This way you don't use On Error Resume Next wrong and you don't run into debug issues because of that. So you have a clean solution.

With OutMail
    .To = Cells(X, 4)
    .CC = Cells(X, 6)
    .Subject = Cells(X, 8)
    .Body = Cells(1, 8)

    Dim FileLocations As Variant
    FileLocations = Array("C:\Users\HKhan\Desktop\Final Macro\" & Cells(X, 1) & "-OICR.xlsx", _
                          "C:\Users\HKhan\Desktop\Final Macro\" & Cells(X, 1) & "-OICLR.xlsx", _
                          "C:\Users\HKhan\Desktop\Final Macro\" & "OIC - Bank Details" & ".pdf", _
                          "C:\Users\HKhan\Desktop\Final Macro\" & "OICL - Bank Details" & ".pdf")

    Dim AttachedFilesCount As Long

    Dim FileLocation As Variant
    For Each FileLocation In FileLocations
        If FileExists(FileLocation) Then
            .Attachments.Add (FileLocation)
            AttachedFilesCount = AttachedFilesCount + 1
        End If
    Next FileLocation

    If AttachedFilesCount > 0 Then
        .Display 'display or send email
    Else
        .Close 'close it if no attachments
    End If

End With

If you now still need additional error handling on adding the attachments (personally I don't think you need it necessarily) you can implement it like this:

On Error Resume Next  'turn error reporting off
.Attachments.Add (FileLocation) 'the line where an error might possibly occur.
If Err.Number <> 0 Then 'throw a msgbox if there is an error
    MsgBox "Could not attach file """ & FileLocation & """ to the email." & vbCrLf & Err.Description, vbExclamation, "Error " & Err.Number, Err.HelpFile, Err.HelpContext
End If
On Error Goto 0 'turn error reporting on again!

回答2:

To add condition to check if OutMail has Excel attachment, simply replace the following

       .Display
        'send

With these codes

Dim Atmt As Object
For Each Atmt In OutMail.Attachments

    Dim sFileType As String
    sFileType = LCase$(Right$(Atmt.fileName, 4)) ' Last 4 Char in Filename
    Debug.Print Atmt.fileName

    Select Case sFileType
        Case ".xls", "xlsx"

         .Display
        '.send

    End Select
Next

来源：https://stackoverflow.com/questions/50111843/send-only-those-emails-that-have-attachments-by-way-of-a-vba-code