How to confirm adding attachment to email worked in VBA Excel - Stack Overflow

admin管理员组

文章数量:1357653

I have built a script that uses a mail list to create individual emails with individual attachments then I manually hit send once I've confirmed the attachment is correct/has been added.

I am hoping to automate the sending once the script has confirmed that the email attachment WAS added correctly.

The issue I have been running into is as follows.

When I run the script, (which I have added an if statement confirming attachment added), the email is sent (in a testing environment), even if the attachment was not added correctly.

I believe this is because the If statement only checks if the MailObj includes a filename, but not if that file actually exists and has been attached to the draft email. Unfortunately, in my use case, it would be almost pointless if I had to add each of the filenames manually for the mail merge, and as such my Mail Merge excel sheet currently automates the filename based upon a convention I will not change. Therefore the cells are populated with a set string which may or may not ACTUALLY link to a file.

I also want the emails that fail to add the attachment to still be created, but not sent so I can debug why the attachment failed.

Here is my script:

Sub emailMergeWithAttachments()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet
    Dim strBody As String
    Dim rowCount As Integer
    Dim i As Integer
    Dim testing As Boolean
    Dim mailsCreated As Integer
    Dim mailsSent As Integer
    
    
    mailsCreated = 0
    mailsSent = 0
    testing = True
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ws.Activate
    rowCount = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
    
    For i = 2 To rowCount
        If ws.Cells(i, 4) Then
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            
            strBody = "Hi " & ws.Cells(i, 1) & _
            ",<p>Please find attached last fortnights Performance Report." & _
            "<p>If you have any issues or questions please reach out via Email."
            
            On Error Resume Next
                With OutMail
                    .To = ws.Cells(i, 3).Text
                    .CC = ""
                    .BCC = ""
                    .Subject = "Individual Performance Report"
                    .Display
                    .HTMLBody = strBody & .HTMLBody
                    .Attachments.Add ws.Cells(i, 5).Text
                    If .Attachments.Count > 0 Then
                        .Send
                        mailsSent = mailsSent + 1
                    End If
                    mailsCreated = mailsCreated + 1
                    
                End With
                On Error GoTo 0
            
            Set OutMail = Nothing
            Set OutApp = Nothing
            If testing Then Exit For
       End If
    Next i
       
    MsgBox (mailsCreated & " emails Created" & vbNewLine & _
        mailsSent & " emails Sent")
    
End Sub

Am I barking up the wrong tree?

I have built a script that uses a mail list to create individual emails with individual attachments then I manually hit send once I've confirmed the attachment is correct/has been added.

I am hoping to automate the sending once the script has confirmed that the email attachment WAS added correctly.

The issue I have been running into is as follows.

When I run the script, (which I have added an if statement confirming attachment added), the email is sent (in a testing environment), even if the attachment was not added correctly.

I believe this is because the If statement only checks if the MailObj includes a filename, but not if that file actually exists and has been attached to the draft email. Unfortunately, in my use case, it would be almost pointless if I had to add each of the filenames manually for the mail merge, and as such my Mail Merge excel sheet currently automates the filename based upon a convention I will not change. Therefore the cells are populated with a set string which may or may not ACTUALLY link to a file.

I also want the emails that fail to add the attachment to still be created, but not sent so I can debug why the attachment failed.

Here is my script:

Sub emailMergeWithAttachments()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim ws As Worksheet
    Dim strBody As String
    Dim rowCount As Integer
    Dim i As Integer
    Dim testing As Boolean
    Dim mailsCreated As Integer
    Dim mailsSent As Integer
    
    
    mailsCreated = 0
    mailsSent = 0
    testing = True
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    
    ws.Activate
    rowCount = WorksheetFunction.CountA(Range("A1", Range("A1").End(xlDown)))
    
    For i = 2 To rowCount
        If ws.Cells(i, 4) Then
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            
            strBody = "Hi " & ws.Cells(i, 1) & _
            ",<p>Please find attached last fortnights Performance Report." & _
            "<p>If you have any issues or questions please reach out via Email."
            
            On Error Resume Next
                With OutMail
                    .To = ws.Cells(i, 3).Text
                    .CC = ""
                    .BCC = ""
                    .Subject = "Individual Performance Report"
                    .Display
                    .HTMLBody = strBody & .HTMLBody
                    .Attachments.Add ws.Cells(i, 5).Text
                    If .Attachments.Count > 0 Then
                        .Send
                        mailsSent = mailsSent + 1
                    End If
                    mailsCreated = mailsCreated + 1
                    
                End With
                On Error GoTo 0
            
            Set OutMail = Nothing
            Set OutApp = Nothing
            If testing Then Exit For
       End If
    Next i
       
    MsgBox (mailsCreated & " emails Created" & vbNewLine & _
        mailsSent & " emails Sent")
    
End Sub

Am I barking up the wrong tree?

• excel
• vba
• outlook
• mailmerge

Share Follow asked Mar 28 at 3:15 mistamadd001mistamadd001 3111 silver badge33 bronze badges 0

Add a comment  | 

3 Answers 3

Sorted by: Reset to default 1

When I run the script, ..., the email is sent (in a testing environment), even if the attachment was not added correctly.

I would consider that a bug in this API if it is not reporting an error if it is unable to process the requested file.

On the other hand, your code is using On Error Resume Next to ignore any error that happens to be raised. Try using On Error Goto ... with an actual error handler, and then see if you are getting a real error reported.

the If statement only checks if the MailObj includes a filename, but not if that file actually exists

That is correct. The attachment file is not processed until the email is saved or sent.

the cells are populated with a set string which may or may not ACTUALLY link to a file

Then you should check the file's existence yourself, using FileSystemObject.FileExists(). But, that is still no guarantee that the file can actually be accessed successfully when needed, even if it does exist.

I also want the emails that fail to add the attachment to still be created, but not sent so I can debug why the attachment failed.

Fix your error handling, and then that will likely work as intended.

Firstly, do not use On Error Resume Next - hiding a problem is not the same as fixing it.

Check if the file exist before adding it. Change the lines

.Attachments.Add filePath
.Send
mailsSent = mailsSent + 1
mailsCreated = mailsCreated + 1

to

If Dir(filePath) <> "" Then
                ' If file exists, add attachment and send
                .Attachments.Add filePath
                If .Attachments.Count > 0 Then
                    .Send
                    mailsSent = mailsSent + 1
                End If
            Else
                ' If file does not exist, show a message box
                MsgBox "The file at " & filePath & " does not exist.", vbExclamation, "File Not Found"
            End If

Instead of relying on .Attachments.Count, you should explicitly check if the file exists before adding it.

Replace your code between the On Error Resume Next and On Error GoTo 0 with the code given below:

On Error Resume Next
            
            Dim filePath As String
            filePath = ws.Cells(i, 5).Text ' Get the file path from the cell
                
            If filePath <> "" And Dir(filePath) <> "" Then ' Check if the file path is not empty and exists
                With OutMail
                    .To = ws.Cells(i, 3).Text
                    .CC = ""
                    .BCC = ""
                    .Subject = "Individual Performance Report"
                    .Display
                    .HTMLBody = strBody & .HTMLBody
                    .Attachments.Add filePath
                    .Send
                    mailsSent = mailsSent + 1
                    mailsCreated = mailsCreated + 1
                End With
            Else
                With OutMail
                    .To = ws.Cells(i, 3).Text
                    .CC = ""
                    .BCC = ""
                    .Subject = "Individual Performance Report"
                    .HTMLBody = strBody & .HTMLBody
                    .Display ' Just display if no attachment
                    mailsCreated = mailsCreated + 1
                End With
            End If

On Error GoTo 0

This code will explicitly check the filepath <> "" and dir(filepath) <> "" ensuring the email is only sent if if an actual file exists. If the filepath is empty (""), then email will only be displayed and not sent.

本文标签： How to confirm adding attachment to email worked in VBA ExcelStack Overflow