Excel VBA Email Loop for Delayed Delivery Dates

[pdevito3]

Hi guys. I'm trying to loop through a table to send several emails at once with a delayed delivery for each email. The code works great up until I get past for first loop. When I run the code, it displays the first email just like it should, but none of the other emails come up. The weird thing is that when I debug it with F8 the varaibles all change appropriately and I get the new information just fine, the email just doesnt display.

Also, the code doesn't send an email at all when I change it from .display to .send, but that's another, less important point.

Any help is appreciated. Thanks in advance.

Private Sub CommandButton1_Click()
'Monthly
Dim MonthlyDate As Date 'Date to Send
Dim MonthlyTime As Double 'Time to Send
Dim FullName As String 'Employee
Dim FirstName As String
Dim Main As Worksheet
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String 'body of the email
Set OutApp = CreateObject("Outlook.Application") 'establishes outlook as a partner application
Set OutMail = OutApp.CreateItem(0) 'creates outlook window
Set Main = ThisWorkbook.Sheets("Sheet1") 'variable for the order requests worksheet
For y = 3 To 8
    For x = 3 To 7
        MonthlyDate = Cells(x, 1)
        MonthlyTime = Cells(x, 2)
        TimeConverted = CDate(MonthlyTime)
        TimeAndDate = MonthlyDate + TimeConverted
        Item = Cells(2, y)
        FullName = Cells(x, y)
        FirstName = Right(FullName, Len(FullName) - Application.WorksheetFunction.Find(" ", FullName))
        
        strbody = "Hi " & FirstName & "," & vbNewLine & vbNewLine & _
                          "text here"
                On Error Resume Next
                With OutMail
                    Test = Application.WorksheetFunction.VLookup(FullName, ThisWorkbook.Sheets("Lists").Range("tblEmployees"), 2, False)
                    .To = Application.WorksheetFunction.VLookup(FullName, ThisWorkbook.Sheets("Lists").Range("tblEmployees"), 2, False)
                    .CC = ""
                    .BCC = ""
                    .Subject = ""
                    .Body = strbody
                    .DeferredDeliveryTime = TimeAndDate
                    .Display 'Change to Send after debugging
                End With
                On Error GoTo 0
    
                Set OutMail = Nothing
                Set OutApp = Nothing
    Next x
Next y

End Sub

 

[JLGWhiz]

Set OutMail = Nothing
Set OutApp = Nothing

Looks Like you are killing your Object Variables on the first iteration and not restoring them for the later iterations. Maybe, eithe move these two statements out side the loops or move the Set statements inside the loops.

 

[s.ridd]

To expand upon that point,you will need to move atleast

[COLOR=#574123][I]Set OutApp = Nothing[/I][/COLOR]

out of the loop and then either way you'll need to move

[COLOR=#574123]Set OutMail = OutApp.CreateItem(0)[/COLOR]

into the loop or you will end up with just one email with the last iteration of the loop's information.

Hope this helps

Simon

 

[pdevito3]

I had commented those out at one point, but didn't know to add the outapp.createitem(0)

Worked like a charm. Thanks, @s.ridd!

 

[pdevito3]

Any idea as to why .display brings up the email fine, but changing it to .send won't send the emails?

 

[JLGWhiz]

Would that not be dependent on the variables DateToSend and TimeToSend ? If they are not equal to Now, then it probably would not send. You can test that by commenting out the delay parameter.

 

[pdevito3]

Well I would think that it would still send them and they would be in my outbox, but that wasn't the case. I tried commenting out the delay too. No dice.

Not completely nessesary, just would like to save my end-user some time.

 

[JLGWhiz]

Odd. It should send if there is no time delay. Maybe I missed something. I haven't worked with Outlook in a while.

 

[s.ridd]

Outlook Security can prevent you from sending an email programmatically from another application, however to receive no indication this is happening is slightly odd. If you remove the "On Error Resume Next" statement do you get an error message or does the code run fine?

 

[JLGWhiz]

Outlook Security can prevent you from sending an email programmatically from another application, however to receive no indication this is happening is slightly odd. If you remove the "On Error Resume Next" statement do you get an error message or does the code run fine?

Good point, s.ridd, I hadn't thought about the security aspect. But I do recall reading something about MS incorporating some protection against third party initiation of email messages. So, it could very well be.