Excel E-mail VBA: Modify code to skip blank cells

exceliana

New Member
Joined
Oct 28, 2021
Messages
3
Office Version
  1. 2019
Platform
  1. Windows
I am having issues with the below VBA code that's used to send out invoices via Excel.

It does not skip the cells that are blank in the "attachment" columns of the worksheet, instead,
it gives me the "File does not exist error" for the first blank and stops the loop completely.

Can someone please assist me with this issue?

Code:

VBA Code:
Sub sendEmailWithAttachments()
    
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim myAttachments As Object
    Dim row As Integer
    Dim col As Integer
    
    Set OutLookApp = CreateObject("Outlook.application")
    row = 2
    col = 1
    ActiveSheet.Cells(row, col).Select
    Do Until IsEmpty(ActiveCell)
        workFile = Application.ActiveWorkbook.Path & "\" & "message.oft"
        If FileExists(workFile) Then
            Set OutLookMailItem = OutLookApp.CreateItemFromTemplate(workFile)
        Else
            MsgBox ("message.oft file does not exist in the folder!" & vbNewLine & _
                "Also verify that the name is exactly 'message.oft'." & vbNewLine & _
                "Exiting...")
            Exit Sub
        End If
        
        Set myAttachments = OutLookMailItem.Attachments
        'Do Until IsEmpty(ActiveCell)
        Do Until IsEmpty(ActiveSheet.Cells(1, col))
            With OutLookMailItem
                If ActiveSheet.Cells(row, col).Value = "xxxFinshAutoEmailxxx" Then
                    'MsgBox ("Exiting...")
                    Exit Sub
                End If
                If ActiveSheet.Cells(1, col).Value = "To" And Not IsEmpty(ActiveCell) Then
                    .To = .To & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Cc" And Not IsEmpty(ActiveCell) Then
                    .CC = .CC & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Bcc" And Not IsEmpty(ActiveCell) Then
                    .BCC = .BCC & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Reply-To" And Not IsEmpty(ActiveCell) Then
                    .ReplyRecipients.Add ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveCell) Then
                    attachmentName = ActiveSheet.Cells(row, col).Value
                    attachmentFile = Application.ActiveWorkbook.Path & "\" & attachmentName
                    If FileExists(attachmentFile) Then
                        myAttachments.Add Application.ActiveWorkbook.Path & "\" & ActiveSheet.Cells(row, col).Value
                    Else
                        MsgBox (Attachment & "'" & attachmentName & "'" & " file does not exist in the folder!" & vbNewLine & _
                            "Correct the situation and delete all messages from Outlook's Outbox folder before pressing 'Send Emails' again!" & vbNewLine & _
                            "Exiting...")
                        Exit Sub
                    End If
                ElseIf ActiveSheet.Cells(1, col).Value = "xxxIgnoreAutoEMailxxx" Then
                    ' Do Nothing
                Else
                    .Subject = Replace(.Subject, ActiveSheet.Cells(1, col).Value, ActiveSheet.Cells(row, col).Value)
                    'Write #1, .HTMLBody
                    .HTMLBody = Replace(.HTMLBody, ActiveSheet.Cells(1, col).Value, ActiveSheet.Cells(row, col).Value)
                    'ActiveSheet.Cells(10, 10) = .HTMLBody
                End If
                
                'MsgBox (.To)
            End With
            'Application.Wait (Now + #12:00:01 AM#)
            
            col = col + 1
            ActiveSheet.Cells(row, col).Select
        Loop
        OutLookMailItem.HTMLBody = Replace(OutLookMailItem.HTMLBody, "xxxNLxxx", "<br>")
        OutLookMailItem.send
        col = 1
        row = row + 1
        ActiveSheet.Cells(row, col).Select
    Loop

End Sub
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
I think your problem is the code has been modfied from operating on the "activecell" to operating on "ActiveSheet.Cells(1, col)" however this hasn't been done in every case so the "isempty" checks are working on the activecell still. so try modifying this code
VBA Code:
               If ActiveSheet.Cells(1, col).Value = "To" And Not IsEmpty(ActiveCell) Then
                    .To = .To & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Cc" And Not IsEmpty(ActiveCell) Then
                    .CC = .CC & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Bcc" And Not IsEmpty(ActiveCell) Then
                    .BCC = .BCC & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Reply-To" And Not IsEmpty(ActiveCell) Then
                    .ReplyRecipients.Add ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveCell) Then
:
to:
VBA Code:
               If ActiveSheet.Cells(1, col).Value = "To" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
                    .To = .To & "; " & ActiveSheet.Cells(Row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Cc" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
                    .CC = .CC & "; " & ActiveSheet.Cells(Row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Bcc" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
                    .BCC = .BCC & "; " & ActiveSheet.Cells(Row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Reply-To" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
                    .ReplyRecipients.Add ActiveSheet.Cells(Row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
 
Upvote 0
Solution
I think your problem is the code has been modfied from operating on the "activecell" to operating on "ActiveSheet.Cells(1, col)" however this hasn't been done in every case so the "isempty" checks are working on the activecell still. so try modifying this code
VBA Code:
               If ActiveSheet.Cells(1, col).Value = "To" And Not IsEmpty(ActiveCell) Then
                    .To = .To & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Cc" And Not IsEmpty(ActiveCell) Then
                    .CC = .CC & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Bcc" And Not IsEmpty(ActiveCell) Then
                    .BCC = .BCC & "; " & ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Reply-To" And Not IsEmpty(ActiveCell) Then
                    .ReplyRecipients.Add ActiveSheet.Cells(row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveCell) Then
:
to:
VBA Code:
               If ActiveSheet.Cells(1, col).Value = "To" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
                    .To = .To & "; " & ActiveSheet.Cells(Row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Cc" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
                    .CC = .CC & "; " & ActiveSheet.Cells(Row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Bcc" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
                    .BCC = .BCC & "; " & ActiveSheet.Cells(Row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "Reply-To" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
                    .ReplyRecipients.Add ActiveSheet.Cells(Row, col).Value
                ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveSheet.Cells(1, col)) Then
I truly appreciate your timely response. I have tried your suggestion, but it gives me the below error messages:
 

Attachments

  • attachment_errorcode.JPG
    attachment_errorcode.JPG
    80.2 KB · Views: 20
  • attachment_errorcode2.JPG
    attachment_errorcode2.JPG
    144.3 KB · Views: 19
Upvote 0
That error has been hidden up to now because you were checking the active cell and not the cells(1,col) . The error itself isn't directly related to the change I suggested, it just that now you have arrived at that line of code with different data than before. From the error message it looks like the data you are using has some errors. So you probably need to modify the logic. Without having a clear idea of what your data looks like and what checks you need to do on it, it is difficult to suggest a change
 
Upvote 0
So, I managed to figure out the issue. I went ahead and modified your suggestion:
VBA Code:
IsEmpty(ActiveSheet.Cells(row, col))
The only thing left was to make sure that the cells were "truly" blank (without the formula that made certain cells blank) and it worked.

Thanks so much for the help!
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,027
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top