How to send email with multiple attachments even when when one is missing?-CodePudding

Have a simple code to send email with attachments from directory.

Problem is when one of the files is missing, email is not sent. I want to send even if only one attachment exist.

Sub Send_email_IPS()

  Dim OutApp As Object
  Dim OutMail As Object

  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)

  With OutMail
    .to = "[email protected]"
    .CC = ""
    .BCC = ""
    .Subject = "Update " & Date & " " & Time
    .HTMLbody = "Hello " & "<br>" & "<br>" & "Please find attached latest update" & "<br>" & "<br>" & "Best Regards" & "<br>" & "<br>" & "Me"
    .Attachments.Add "C:\Users\testuser\Work Folders\Desktop\KB4 Reporting Macro\IPS.xlsx"
    .Attachments.Add "C:\Users\testuser\Work Folders\Desktop\KB4 Reporting Macro\IPS (St Helens).xlsx"
    .Display
  End With

  On Error GoTo 0

  Set OutMail = Nothing
  Set OutApp = Nothing

End Sub

CodePudding user response：

As advised in comments, add the attachment only if the file exists.

Const File1 As String = "C:\Users\testuser\Work Folders\Desktop\..."
Const File2 As String = "C:\Users\testuser\Work Folders\Desktop\..."

With OutMail
    '...
    If Len(Dir(File1)) > 0 Then .Attachments.Add File1
    If Len(Dir(File2)) > 0 Then .Attachments.Add File2
    .Display
End With

To make a note if the file was not found, use the Else condition to write to the body of the email. Change the content to fit your needs.

If Len(Dir(File1)) > 0 Then .Attachments.Add File1 Else .HTMLbody = .HTMLbody & "<p> File not found: '" & File1 & "'</p>"
If Len(Dir(File2)) > 0 Then .Attachments.Add File2 Else .HTMLbody = .HTMLbody & "<p> File not found: '" & File2 & "'</p>"