Mass Email Macro Not looping to list of emails

[HanSam]

I am running the code below, but I am having problems with it looping to the whole list of email address. It only generates one email, and it is being sent to the 1st email add. What should I change?

Option Explicit

Sub DistroPDF()

Application.ScreenUpdating = False

    With Application
        If .Calculation <> xlCalculationAutomatic Then
           .Calculation = xlCalculationAutomatic
        End If
    End With

    ThisWorkbook.Activate
    
    'Declares variables used on the code
    
    Dim outApp As Object
    Dim outMail As Object
    
    Dim distro As Worksheet
    Dim setup As Worksheet
    
    Dim sendTo, subj, attachment, msg, ccTo, sender As String
    Dim status, stamp As String
    Dim line1, line2, line3, line4, line5, line6, line7 As String
    
    Dim lastRow As Long
    Dim rng As Range
    Dim cell As Range
    Dim s As String
    s = Environ("appdata") & "\Microsoft\Signatures\"
    If Dir(s, vbDirectory) <> vbNullString Then s = s & Dir$(s & "Henkel Personal.htm") Else s = ""
    s = CreateObject("Scripting.FileSystemObject").GetFile(s).OpenAsTextStream(1, -2).ReadAll
    
    'defines the sheets assigned to the variables
    Set setup = ThisWorkbook.Sheets("SetUp")
    Set distro = ThisWorkbook.Sheets("Distro")
    
    distro.Activate
    lastRow = Cells(Rows.Count, 3).End(xlUp).Row
    
    Set rng = Nothing
    'counts the numbers of rows and is the number of emails going to be generated
    Set rng = Range("C2:C" & lastRow)
    
    'creates email
    Set outApp = CreateObject("Outlook.Application")
    Set outMail = outApp.CreateItem(0)
    
    'error catchers
    On Error GoTo cleanup
    
    For Each cell In rng 'loops within the list
        
        sender = setup.Range("B2").Value2
        sendTo = Range(cell.Address).Offset(0, 0).Value2 'defines where the emails are sent
        subj = setup.Range("B1").Value2 'defines the subject (subject can be modified on sheet Setup)
        attachment = "\" & Range(cell.Address).Offset(0, 2).Value2 'defines the attachments per email
        'ccTo = Range(cell.Address).Offset(0, 1).Value2 'defines anyone copied on the email
        
        msg = Range(cell.Address).Offset(0, -2).Value2
        
        line1 = setup.Range("B4")
        line2 = setup.Range("B5")
        line3 = setup.Range("B6")
        line4 = setup.Range("B7")
        line5 = setup.Range("B8")
        line6 = setup.Range("B9")
        line7 = setup.Range("B10")
        
        On Error Resume Next
    
        With outMail 'actual email creation
            .SentOnBehalfofName = sender
            .To = sendTo
            '.CC = ccTo
            .Subject = subj
            .Attachments.Add (ThisWorkbook.Path & attachment)
            '"<p style='font-family:Segoe UI;font-size:14'>" &
            .HTMLBody = "Dear " & msg & "," & "<br><br>"
            .HTMLBody = .HTMLBody & line1 & "<br><br>"
            .HTMLBody = .HTMLBody & line2 & "<br>"
            .HTMLBody = .HTMLBody & line3 & "<br><br>"
            .HTMLBody = .HTMLBody & line4 & "<br><br>"
            .HTMLBody = .HTMLBody & line5
            '.HTMLBody = .HTMLBody & line6
            '.HTMLBody = .HTMLBody & line7
            .HTMLBody = .HTMLBody & s
            .ReadReceiptRequested = True
            .Send 'this code will send the email.
                  'If you want to see the email first before it is sent out,
                  'use .Display instead
        
        End With
        
        status = Range(cell.Address).Offset(0, 3).Select
        ActiveCell.FormulaR1C1 = "Sent" 'Status of the email
        stamp = Range(cell.Address).Offset(0, 4).Select
        ActiveCell.FormulaR1C1 = "=NOW()" 'timestamp for when the email is sent
        
        On Error Resume Next
        Set outMail = Nothing
        
    Next cell 'loop

cleanup:
    Set outApp = Nothing
    With Application
        .DisplayAlerts = False
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

 

[6StringJazzer]

Move this line to after the For statement so it is inside the loop.

Set outMail = outApp.CreateItem(0)

You keep reusing the same email object after you have already sent it so nothing else happens.

 

[KenU]

I believe you need to edit the line below

    For Each cell In rng 'loops within the list

with this

    For Each cell In rng.Cells

Hope that helps!

Regards,
Ken

 

[BobBridges]

Not the same kind of suggestion as the others, but probably just as useful: Get used to <F8> and the other debugging keystrokes that you'll find under the Debug item on your VBE ribbon. If you can't figure out by looking at your program what exactly is going wrong, you can usually do it by running it one step at a time, watching what it does, and seeing specifically where it goes off the rails.

 

[6StringJazzer]

I believe you need to edit the line below

    For Each cell In rng 'loops within the list

with this

    For Each cell In rng.Cells

Hope that helps!

Regards,
Ken

These two lines of code are functionally equivalent. If the second one works, the first one should work.

 

[BobBridges]

If Mr Jazzer is correct (and I expect he is), it will be because Cell is the "default property" of a Range object. I don't know from personal knowledge, mostly because I prefer not to depend upon defaults; I tend to spell things out.

Now that I look at this program in more detail, I'm disturbed by the fact that you create an email item outside the loop; then inside the loop you assign it properties, send it, then set the email object to Nothing. I would think you want to create a new email item inside the loop every time.

 

[6StringJazzer]

If Mr Jazzer is correct (and I expect he is), it will be because Cell is the "default property" of a Range object. I don't know from personal knowledge, mostly because I prefer not to depend upon defaults; I tend to spell things out.

That's correct. Spelling things out is a good practice. I am not suggesting what you should do, only that the two versions do the same thing, so that is not the source of the problem.

Now that I look at this program in more detail, I'm disturbed by the fact that you create an email item outside the loop; then inside the loop you assign it properties, send it, then set the email object to Nothing. I would think you want to create a new email item inside the loop every time.[/S][/COLOR][/SIZE][/FONT]

That was the solution I proposed earlier in the thread.

 

[BobBridges]

Ah, so you did. I wasn't paying close attention to this thread back then. Sorry.