Results 1 to 2 of 2

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

  1. #1

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



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

  2. #2
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •