Automating Emails - vba

Question

My excel spreadsheet has email a number of email addresses in column B that the email is to be sent to and addresses in column E that the email is to be cc to. in A1 I have today's date (which updates) and in B1 I have the date the email needs to be sent and in C1 I have another date 6 months later the email needs to be sent.
Here is my code:
Private Sub workbook_Open()
Dim Subject, Send_From, Send_To, cc, body As String
Dim Email_Range, cl, cc_Range, cx As Range
Dim Due_Date, Today_Date, Send_Date As Date
Today_Date = Range ("A1").Text
Due_Date = Today_Date + 7
Send_Date = Range ("B1").Text
Dim Mail_Object, Mail_Single As Variant
Set Email_Range = Range("B3:B14")
For Each cl In Email_Range
Sent_To = Send_To & ";" & cl.Value
Next
Send_To = Mid(Send_To, 2)
Set cc_Range = Range("E3:E14")
For Each cx In cc_Range
cc = cc & ";" & cx.Value
Next
cc = Mid(cc, 2)
Subject="subject"
Send_From="me#example.com"
Body="Please respond by" & "Due_Date" & "Thank You"
On Error GoTo debugs
Set Mai_Object = Create Object ("Outlook Application")
Set Mail_Single - Mail_Object, Create Item(0)
With Mail_Single
.Subject=Subject
.To=Send_To
.cc=cc
.Body=Body
.Send
End With
debugs:
If Err.Description c>"" Then Msg Box
Err.Description
End Sub
The program will send an email when I run it, but I need the program to send an email on the send date automatically (when due date=send date) and then when someone responds, take them off the email list. Repeat this until everyone has responded and then do it all again the next send date (different cell).
I have no idea where to start as I am pretty knew at this. Does anyone have any ideas?

Answer 1

There is a solution using Excel and Outlook utilising Outlook's task reminders, but it will send emails at the precise time only if your Outlook software is actively running at the moment a reminder event occurs. If you start Outlook and have 'missed' one or more scheduled events (because Outlook was turned off at the time), then emails corresponding with those missed scheduled events will occur shortly after Outlook starts. I'm assuming you have Outlook available as you are using Excel.
Excel Component Solution
I've created a spreadsheet that is slightly different to yours, but you can adapt as necessary. The spreadsheet has two separate sheets named "Recipients" and "Emails". The "Recipients" sheet contains a list of each email recipient along with three dates on which they should receive emails if they have not yet responded.
The "Emails" sheet contains content that is to be placed in each email:
Within the ThisWorkbook code for the spreadsheet, I added the following procedures. These are responsible for creating tasks within Outlook for which reminders will fire at particular times in the future. Each task will contain sufficient information to generate an email to a nominated recipient.
Sub CreateOutlookTask(name As String, destination As String, emailNum As Integer, sendDate As Date)
With CreateObject("Outlook.Application").CreateItem(3)
.Subject = Worksheets("Emails").Cells((emailNum + 1), "A").Value
.Role = destination
.StartDate = sendDate
.DueDate = sendDate
.ReminderTime = sendDate
.ReminderSet = True
.Body = Trim(Worksheets("Emails").Cells((emailNum + 1), "B").Value) + _
" " + name + "," + vbLf + vbLf + _
Worksheets("Emails").Cells(emailNum + 1, "C").Value + _
vbLf + vbLf + _
"This email was sent to " + destination + _
" by XYZ Corporation [add reason]."
.Categories = "AutoSend"
.Save
End With
End Sub
Sub ProcessRecipients()
Dim rowNum As Integer
Dim lastRowIdx As Integer
lastRowIdx = Worksheets("Recipients").Cells(Rows.Count, "B").End(xlUp).Row
For rowNum = 2 To lastRowIdx
With Worksheets("Recipients")
Call CreateOutlookTask(.Cells(rowNum, "A"), .Cells(rowNum, "B"), 1, .Cells(rowNum, "C"))
Call CreateOutlookTask(.Cells(rowNum, "A"), .Cells(rowNum, "B"), 2, .Cells(rowNum, "D"))
Call CreateOutlookTask(.Cells(rowNum, "A"), .Cells(rowNum, "B"), 3, .Cells(rowNum, "E"))
End With
Next
End Sub
Running the ProcessRecipients() macro within the Excel workbook will create three tasks in Outlook for each recipient listed on the "Recipients" sheet. However, the email magic won't happen until the following section is complete.
Outlook Component Solution
Two separate actions need to occur within Outlook. The first is the actual sending of emails at nominated times, and the second is looking for and processing the responses.
Automatically processing received emails is made more complicated by the fact the email address of the responder may not be the same as the email address of the originally intended recipient. By placing the intended recipient's email address within the body of the original email, it is highly likely that any response will include the original email and thus include a reference to the originally intended recipient. The automatic processing of emails looks known text within the subject heading string as well as a reference to an originally intended recipient's email address in the received email body.
The following VBA code needs to be placed in a (new) module within Outlook's VbaProject.OTM file. This code will become a rule that will be run whenever an email is received by the Outlook client.
' Create a rule that calls this macro each time an email is received.
' All tasks that are flagged with the 'AutoSend' category will be searched
' and the email destination for that task extracted from the task's 'role'
' field. If the received email explicitly refers to that email address, then
' the task will be deleted.
'
' It cannot be assumed that the sender of a response email will be the same
' email address as the email used to send the original email (i.e. it could
' have been forwarded, or simply be an alias for the actual recipient. We
' must therefore search the body of the response to look for a reference to
' the originally intended recipient email address.
'
Sub ProcessAutoEmailResponses(email As MailItem)
Dim task As Outlook.TaskItem
Dim items As Outlook.items
Dim folder As Outlook.MAPIFolder
Dim deletedTasks As String
Dim autoProcess As Boolean
autoProcess = False
Set folder = Application.Session.GetDefaultFolder(olFolderTasks)
Set items = folder.items
' If the incoming email subject contains any of the strings defined
' by an 'AutoReceive' task category subject
Set task = items.Find("[Categories] ='AutoReceive'")
Do While (Not task Is Nothing) And (autoProcess = False)
If (InStr(1, email.Subject, task.Subject) > 0) Then
autoProcess = True
End If
Set task = items.FindNext
Loop
If (autoProcess = True) Then
deletedTasks = "AutoSend Processing Triggered"
' loop through all AutoEmail categorised tasks
Set task = items.Find("[Categories] ='AutoSend'")
Do While (Not task Is Nothing)
' if the email contains a reference to the task's destination email address
If (InStr(1, email.Body, task.Role) > 0) Then
deletedTasks = deletedTasks & ", Deleted Reminder " & task.DueDate & " (" & task.Subject & ")"
' delete the task
task.Delete
End If
Set task = items.FindNext
Loop
' Insert note to indicate tasks have been deleted
email.Body = deletedTasks + vbLf + email.Body
email.Subject = "[AUTOSEND PROCESSED] " + email.Subject
email.Save
End If
End Sub
A second block of code needs to be placed in the ThisOutlookSession area of the VbaProject.OTM codebase. This code is executed whenever a reminder fires.
Note there are several ways to do this, and although I ended up not 'cancelling' the reminder window via this event handler, the BeforeReminderShow event handler is (I believe) the only way to control whether the reminder window is actually made visible as a result of a reminder firing. It might be something you wish to play with further.
Private WithEvents olRemind As Outlook.Reminders
Private Sub Application_Reminder(ByVal item As Object)
Set olRemind = Outlook.Reminders
End Sub
'
' Auto-dismiss/cancel reminders that would otherwise
' be displayed for "AutoSend" categorised items
'
Private Sub olRemind_BeforeReminderShow(Cancel As Boolean)
Dim reminderObj As Reminder
Dim item As TaskItem
For Each reminderObj In olRemind
If (reminderObj.IsVisible = True) Then
If (TypeName(reminderObj.item) = "TaskItem") Then
If reminderObj.item.Categories = "AutoSend" Then
Dim email As MailItem
Set email = Application.CreateItem(olMailItem)
email.To = reminderObj.item.Role
email.Subject = reminderObj.item.Subject
email.Body = reminderObj.item.Body
email.Send
reminderObj.item.ReminderSet = False
reminderObj.item.Save
reminderObj.Dismiss
End If
End If
End If
Next
End Sub
Important: Outlook macros are usually prohibited under the default Outlook configuration. It is best to sign your code and permit the execution of signed macros. Once your code is run once, you can nominate to 'always allow' that code to run, thereby eliminating permission problems.
This blog provides instructions for 'self-signing' your VBA project: http://www.remkoweijnen.nl/blog/2011/01/12/self-signing-word-macros/.
Final Steps
Create one or more 'tasks' within outlook (no date necessary) that contain the email subject headings as their titles and tag them with a category called 'AutoReceive'. These will control which emails are automatically processed based on the content of their email subject.
You'll now need to set-up a rule within Outlook to run the ProcessAutoEmailResponses(MailItem) method by going to Tools->Manage Rules and Alerts (or similar, depending on your Outlook version) and creating a rule that runs the method whenever a new email arrives.

Answer 2

As previously stated in a comment by Matt Rowland, Excel is not really the proper choice to do something like that. The easiest way to accomplish that would be probably using an SQL Server (or any other DB-Server) with the ability to send out emails.
The main problem is that you want Excel to run on a particular date / time. Yet, Excel is not running day and night on your computer. So, if Excel is not open / running on the particular date / time you want it to, then Excel cannot send out the requested emails.
Still, if the task has to be accomplish using Excel this is possible. First, you will have to make sure that you have a computer running day and night so that the computer is really on and running on the requested dates. Second, you need to setup the Windows Task (https://en.wikipedia.org/wiki/Windows_Task_Scheduler) to open Excel with the file you setup for that purpose (with the above code). To be really specific, you can even use the VBA function Application.OnTime (https://msdn.microsoft.com/en-gb/en-en/library/office/ff196165.aspx) to run your above procedure at a particular time.