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

[exceliana]

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:

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

 

[offthelip]

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

               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:

               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

 

[exceliana]

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

               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:

               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:

 

[offthelip]

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

 

[exceliana]

So, I managed to figure out the issue. I went ahead and modified your suggestion:

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!