VBA for Sending to a list of Emails and continue to bottom of last Row

craigw02 · Sep 10, 2014

Hi there I have the attached sheet which I have started VBA coding to send emails to a list of email addresses, but I want it to continue to the bottom of the very last row of the excel spreadsheet and then stop. So far this only does the very first email address on row A1 but I also wish for it to send the email if column "G2" says "YES" down to the last row also if this makes sense?

Sub CreateMail()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range

Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)

With ActiveSheet
Set rngTo = .Range("a2")
Set rngSubject = .Range("e2")
Set rngCC = .Range("c2")
Set rngBody = .Range("f2")
Set rngAttach = .Range("d2")
End With

With objMail
.To = rngTo.Value
.Subject = rngSubject.Value
.Body = rngBody.Value
.Attachments.Add rngAttach.Value
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
.CC = rngCC.Value
End With

Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing

End Sub

Bob Phillips · Sep 11, 2014

Code:

Sub CreateMail()
Dim objOutlook As Object
Dim ws As Worksheet
Dim objMail As Object
Dim lastrow As Long
Dim i As lastrow


    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
    
    Set ws = ActiveSheet
    
    lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    With objMail
        
        For i = 2 To lastrow
        
            .To = .Cells(i, "A").Value
            .CC = .Cells(i, "C").Value
            .Subject = .Cells(i, "E").Value
            .Body = .Cells(i, "F").Value
            .Attachments.Add .Cells(i, "D").Value
            .Display 'Instead of .Display, you can use .Send to send the email _
            or .Save to save a copy in the drafts folder
        Next i
    End With
    
    Set objOutlook = Nothing
    Set objMail = Nothing
End Sub

VBA for Sending to a list of Emails and continue to bottom of last Row

craigw02

New member

Bob Phillips

Super Moderator