Home If Macro cannot find attachment do not create email and move to next row
Reply: 0

If Macro cannot find attachment do not create email and move to next row

user2946
1#
user2946 Published in July 22, 2018, 8:37 am

Sorry I am very new to VBA. I have a vba that creates a email, attaches a file to the email, and sends it. It works perfectly if the file is present in the folder. My problem is there may not always be a file to attach. This is a daily email and 1 recipient will be on today's email list but not tomorrows.

So I have a list of vendors. I would like the VBA to go through each row of the list. Create the email, attached the file, and send the email. For the most part the VBA works. Expect for when the file is not in the folder. If the file is not in the folder I would like the VBA to continue to the next row and not stop.

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)
    Set OutLookMailItem = OutLookApp.CreateItemFromTemplate(Application.ActiveWorkbook.Path & "\" & "message.oft")
    Set myAttachments = OutLookMailItem.Attachments
    'Do Until IsEmpty(ActiveCell)
    Do Until IsEmpty(ActiveSheet.Cells(1, col))
        With OutLookMailItem
            If ActiveSheet.Cells(row, col).Value = "xxxFINISHxxx" 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 = "attachment" And Not IsEmpty(ActiveCell) Then
              myAttachments.Add Application.ActiveWorkbook.Path & "\" & ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "xxxignorexxx" 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
You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.305301 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO