Excel VBA Email Loop for Delayed Delivery Dates

pdevito3

Board Regular
Joined
Dec 17, 2013
Messages
246
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.

Code:
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
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
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.
 
Upvote 0
To expand upon that point,you will need to move atleast
Code:
[COLOR=#574123][I]Set OutApp = Nothing[/I][/COLOR]
out of the loop and then either way you'll need to move
Code:
[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
 
Upvote 0
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!
 
Upvote 0
Any idea as to why .display brings up the email fine, but changing it to .send won't send the emails?
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
Odd. It should send if there is no time delay. Maybe I missed something. I haven't worked with Outlook in a while.
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top