Assistance with Sending an Email on a Loop

[Tommy1115]

I am having issues writing a loop code so that it sends an email to the person in row 1, then moves down and sends to the person in row 2, and so on until there is not an email address listed.
The code itself works great on the 1st line of data. It shows exactly how I want the email to look, but will not loop or move down.
- I have attempted a LOOP to run until the email address cell is empty, no luck.
- I then attempted to determine the number of email addresses listed and run the LOOP that many times, but still no success.
Both attempts stop after the first email is generated

Sub Macro_Send_Email()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

' This sets the path so that I can insert logo and my signature into the signature line of the email
    Dim strPicPath As String
        strPicPath = "C:\Users\Tom\ASDFSignature.jpg"
    Dim strPicPath1 As String
        strPicPath1 = "C:\Users\Tom\ASDFSignatureTom.jpg"
    
    
' Cell "K2" is where the 1st email address is
' Side note, I didn't include it on this VBA, but I sort my data by column K, so that ALL of the email addresses show first, then those w/out show afterwards.
    Dim currentCell As Range
    Set currentCell = Range("k2")


' This sets my "loop counter" at 1
    Dim i As Integer
    i = 1
    
    
 ' Cell "AB1" shows the number of cells from Column K that contain email addresses. I thought this would help determine the number of times the loop needs to run.
     Do While i <= Range("AB1").Value
    
    
' Anytime there is a currentCell.Offsett(#,#), it is selecting data from my sheet.  So for instance, (0,24) will move over and insert the customer's first name and so on.
' I have removed a lot of the actual email content so sorry if it doesn't make sense
    strbody = "Hello " & currentCell.Offset(0, 24).Value & ",<br> <br>" & _
                "Blah.  " & _
                "Your account number is " & currentCell.Offset(0, -10).Value & " come visit us <A HREF=""https://yahoo.com/"">locations.</A><br><br> " & _
                "If you have any questions about a product, price, or availability do not hesiate to give us a call at " & currentCell.Offset(0, 22).Value & _
                ".  <br>When you do call, please let us know that you have a Commercial Account with us so that we can provide you with your contractor pricing.<br><br><br>" & _
                "Thank you, <br>" & _
                "<img src=""ASDFSignatureTom.jpg""><br>" & _
                "Tom <br>" & _
                "<A HREF=""http://www.yahoo.com"">Yahoo!</A> <br>" & _
                "911 Office <br>" & _
                "912 Mobile <br><br>" & _
                "<img src=""ASDFSignature.jpg"">" & _
                "<h4>""Tag line here!""</h4>"

    On Error Resume Next

    With OutMail
' currentCell.Value is the customers email address
        .To = currentCell.Value
        
        
' This will eventually be the store managers email address
' My Note: currentCell.Offset(0, 20).Value
        .CC = ""
        .BCC = ""
        .Subject = "Commercial Account"
        .HTMLBody = strbody ' & "<br>" & Signature
        '.Send    'or use .Display
        .Display
    End With

    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing


' This adds one to my counter and SHOULD stop when this counter equals the value in cell "AB1"
    i = i + 1


' This is supposed to move down 1 row.  So if starting cell was "K2", new cell would be "K3" so that the code would then pull data off of Row 3.
' Next loop would update this to Row 4 and so on
    Set currentCell = currentCell.Offset(1, 0)

Loop

End Sub

 

[Joe4]

I think you need to temporarily comment out this line:

    On Error Resume Next

as you may be getting errors, but then ignoring them, so you have no idea what is going on!

Whenever you are error debugging, you do NOT want to ignore the errors, but see exactly what they are telling you.

Also, I would recommend stepping into your code and then stepping through it one line at a time, using the F8, so you can watch the exact path the workflow takes, especially as it ends the first loop and should be going on to the second.

If you do these two things, hopefully the error/issue will become readily apparent.

 

[Tommy1115]

I think you need to temporarily comment out this line:

    On Error Resume Next

as you may be getting errors, but then ignoring them, so you have no idea what is going on!

Whenever you are error debugging, you do NOT want to ignore the errors, but see exactly what they are telling you.

Also, I would recommend stepping into your code and then stepping through it one line at a time, using the F8, so you can watch the exact path the workflow takes, especially as it ends the first loop and should be going on to the second.

If you do these two things, hopefully the error/issue will become readily apparent.

Ok, so I removed that line and ran the code using the F8 key.
The first loop ran thru just fine, opened up the email.

It did begin the LOOP again, but then stopped with a Run-Time error "91": Object variable or With block variable not set
When I clicked Debug, this is the line it referred to:

.To = currentCell.Value

I am stumped on next steps. Based on what I've seen/read, i am assuming I need to set the currentCell.value within the "when" statement?
I set it to K2 outside of the when statement, but how do I accomplish this and still have the cell move down 1 row?

Thanks!!

 

[Joe4]

See if this works any better:

Sub Macro_Send_Email()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String
    Dim lr As Long
    Dim r As Long

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

' This sets the path so that I can insert logo and my signature into the signature line of the email
    Dim strPicPath As String
        strPicPath = "C:\Users\Tom\ASDFSignature.jpg"
    Dim strPicPath1 As String
        strPicPath1 = "C:\Users\Tom\ASDFSignatureTom.jpg"
    
' Calculate the last row in columnn K with an entry
    lr = Cells(Rows.Count, "K").End(xlUp).Row
    
' Check to make sure at least one row with data
    If lr = 1 Then
        MsgBox "No data in column K!", vbOKOnly, "PROCESS ABORTED!"
        Exit Sub
    End If
    
' Loop through all rows
    For r = 2 To lr
    
' Check to see if email address in K
        If Cells(r, "K") = "" Then
            MsgBox "Email address column (K) blank on row " & r, vbOKOnly, "ROW SKIPPED!"
        Else
    
    
' Pulls values from columns A, AG, and AI from current row
' I have removed a lot of the actual email content so sorry if it doesn't make sense
            strbody = "Hello " & Cells(r, "AI").Value & ",<br> <br>" & _
                "Blah.  " & _
                "Your account number is " & Cells(r, "A").Value & " come visit us <A HREF=""https://yahoo.com/"">locations.</A><br><br> " & _
                "If you have any questions about a product, price, or availability do not hesiate to give us a call at " & Cells(r, "AG").Value & _
                ".  <br>When you do call, please let us know that you have a Commercial Account with us so that we can provide you with your contractor pricing.<br><br><br>" & _
                "Thank you, <br>" & _
                "<img src=""ASDFSignatureTom.jpg""><br>" & _
                "Tom <br>" & _
                "<A HREF=""http://www.yahoo.com"">Yahoo!</A> <br>" & _
                "911 Office <br>" & _
                "912 Mobile <br><br>" & _
                "<img src=""ASDFSignature.jpg"">" & _
                "<h4>""Tag line here!""</h4>"

            'On Error Resume Next

            With OutMail
' Get email address from column K
                .To = Cells(r, "K")
                
' This will eventually be the store managers email address
                .CC = ""
                .BCC = ""
                .Subject = "Commercial Account"
                .HTMLBody = strbody ' & "<br>" & Signature
        '.Send    'or use .Display
                .Display
            End With

            'On Error GoTo 0
        End If
        
    Next r

    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub