I had a special request from a user who wanted to automate sending messages on a schedule. He tried using a macro to send a message written in a task when the reminder fires but his messages included hyperlinks and the formatting was messed up in the conversion from RTF (in the task body) to HTML in the email. He asked if there was a way to create the drafts, with the send date in the subject, then use a macro to send the messages.
The answer is in the macro below.
This macro assumes the messages are in the Drafts folder with a subject line in the format of "201503050900 intended message subject" where 201503050900 is the date and time the message should be released, in yyyymmddhhmm format. The macro compares the current time to the time represented in the subject and if the current time is greater, strips the time from the subject and sends the message.
To send the messages, you need to run the macro or use the do something when a reminder fires macro (or another macro) to trigger this macro.
Because the macro is not constantly running and checking the folder, messages may not be sent at the exact time in the subject. If you need messages sent at a specific time, use the deferred message setting instead.
Public Sub SendDrafts() Dim olApp As Outlook.Application Dim NS As Outlook.NameSpace Dim DraftsFolder As Outlook.MAPIFolder Dim Drafts As Outlook.Items Dim DraftItem As Outlook.MailItem Dim sDate As Variant Dim sSubject As Variant Dim lDraftCount As Long Set olApp = Outlook.Application Set NS = olApp.GetNamespace("MAPI") Set DraftsFolder = NS.GetDefaultFolder(olFolderDrafts) Set Drafts = DraftsFolder.Items sDate = Format(Now, "yyyymmddhhmm") 'Loop through all Draft Items For lDraftCount = Drafts.Count To 1 Step -1 Set DraftItem = Drafts.Item(lDraftCount) sSubject = Left(DraftItem.Subject, 12) If sDate > sSubject Then DraftItem.Subject = Right(DraftItem.Subject, Len(DraftItem.Subject) - 12) 'Send Item DraftItem.Send End If Next lDraftCount 'Clean-up Set DraftsFolder = Nothing Set NS = Nothing Set olApp = Nothing End Sub
Trigger the macro using a task
To trigger the macro when a task reminder fires and reset the reminder, create a task and assign the category "draft mail". Then put the following macro in ThisOutlook Session.
Do not dismiss the task!
Private Sub Application_Reminder(ByVal Item As Object) If Item.MessageClass <> "IPM.Task" Then Exit Sub End If If Item.Categories <> "draft mail" Then Exit Sub End If ' run it every 30 minutes Item.ReminderTime = Now() + 0.02083 Item.Save ' call macro SendDrafts End Sub
How to use macros
First: You will need macro security set to low during testing.
To check your macro security in Outlook 2010 or 2013, go to File, Options, Trust Center and open Trust Center Settings, and change the Macro Settings. In Outlook 2007 and older, it’s at Tools, Macro Security.
After you test the macro and see that it works, you can either leave macro security set to low or sign the macro.
Open the VBA Editor by pressing Alt+F11 on your keyboard.
To put the code in a module:
- Right click on Project1 and choose Insert > Module
- Copy and paste the macro into the new module.
To use the macro code in ThisOutlookSession:
- Expand Project1 and double click on ThisOutlookSession.
- Copy then paste the macro into ThisOutlookSession. (Click within the code, Select All using Ctrl+A, Ctrl+C to copy, Ctrl+V to paste.)
More information as well as screenshots are at How to use the VBA Editor