• Outlook User
  • Exchange Admin
  • Office 365
  • Outlook Developer
  • Outlook.com
  • Outlook Mac
  • Outlook & iCloud
    • Common Problems
    • Outlook BCM
    • Utilities & Addins

Scheduling Drafts in Outlook

Slipstick Systems

› Developer › Scheduling Drafts in Outlook

Last reviewed on June 9, 2016     22 Comments

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.

send draft mail

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:

  1. Right click on Project1 and choose Insert > Module
  2. Copy and paste the macro into the new module.

To use the macro code in ThisOutlookSession:

  1. Expand Project1 and double click on ThisOutlookSession.
  2. 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

Scheduling Drafts in Outlook was last modified: June 9th, 2016 by Diane Poremsky
  • Twitter
  • Facebook
  • LinkedIn
  • Reddit
  • Print

Related Posts:

  • Send an Email When a Reminder Fires
  • Open a Webpage when a Task Reminder Fires
  • Use this macro to send an attachment to email addresses in the To line
    VBA: No attachments to CC'd recipients
  • A macro that checks the number of recipients on an outgoing Outlook me
    Check messages you send for number of recipients

About Diane Poremsky

A Microsoft Outlook Most Valuable Professional (MVP) since 1999, Diane is the author of several books, including Outlook 2013 Absolute Beginners Book. She also created video training CDs and online training classes for Microsoft Outlook. You can find her helping people online in Outlook Forums as well as in the Microsoft Answers and TechNet forums.

Subscribe
Notify of
22 Comments
newest
oldest most voted
Inline Feedbacks
View all comments

Henry (@guest_214828)
February 27, 2020 8:11 pm
#214828

Hi,
I like your macro idea.
I was wondering if you can program something like this also in Microsoft Power Automate, so that the automatic flow will take care of this even if my computer is shut down.
The benefit would be, that the prepared emails will be automatically send out even if computer is switched off. Everything will happen in the cloud.
What do you think?

0
0
Reply
Whitney (@guest_209108)
October 25, 2017 7:23 pm
#209108

Hi-
I would like a scheduled a draft email to forward when a recurring task fires. (One example, I have a task set to go off every two weeks to email managers and remind them to approve timecards, which I have saved as a draft email that I just forward so a copy stays in the drafts.) I tried modifying the code, but it's not working. I've done macros in Excel, but not in Outlook so I'm a bit lost. Can you please help?

0
0
Reply
Diane Poremsky(@diane-poremsky)
Author
Reply to  Whitney
October 26, 2017 7:36 pm
#209121

what modification did you make? does it do anything?

This sends based on the date in the subject, but it sounds like you could use just a subject filter. Instead of this:
sSubject = Left(DraftItem.Subject, 12)
If sDate > sSubject Then
DraftItem.Subject = Right(DraftItem.Subject, Len(DraftItem.Subject) - 12)
use this:
if DraftItem.Subject = "Do the time cards!!!"
' send

or use this method at https://www.slipstick.com/developer/send-email-outlook-reminders-fires/ where the message body is in the appointment item (you can change it to use a task) - or use it to bring up a template, which can be pre-addressed to the recipients.

If tasks doesn't have a field you can use to store addresses, you could put them in the body, something like
|to| a@b.com; b@b.com
and pull the addresses out using a functions or regex.

(FWIW, the big difference between outlook vba and excel vba is that outlook doesn't have a macro recorder to get you started and it has a bunch of different windows - excel has workbooks, worksheets and cells... outlook has the main outlook window, selected items, open items... and new items, all with a bunch of fields. Once you get past that, it's all VBA. :))

0
0
Reply
Dom (@guest_203635)
December 31, 2016 9:19 am
#203635

Hi Diane,
I modified your code so that all the items in the draft folder are counted and only 98 are sent. Then using your unmodified macro code set up as a task which should loop through every 30 minutes and send the second batch of 98 draft emails. When the task fires, it takes 98 draft emails and sends them, but it never repeats. Can you see what I am doing wrong in the code below?

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 lDraftCount As Long

Set olApp = Outlook.Application
Set NS = olApp.GetNamespace("MAPI")

Set DraftsFolder = NS.GetDefaultFolder(olFolderDrafts)
Set Drafts = DraftsFolder.Items

'Loop through all Draft Items
lstNumber = Drafts.Count - 97
  If lstNumber &lt; 1 Then
    lstNumber = 1
  End If
  For lDraftCount = Drafts.Count To lstNumber Step -1
    Set DraftItem = Drafts.Item(lDraftCount)
   'Send Item
    DraftItem.Send
  Next lDraftCount

'Clean-up

Set DraftsFolder = Nothing
Set NS = Nothing
Set olApp = Nothing

End Sub

0
0
Reply
Dom Fino (@guest_203532)
December 23, 2016 11:08 am
#203532

Thank you for this code. I modified it to suit my needs but have one question. I want to limit the sent emails to 99. Send them then wait the 30 minutes and send the next 99 until all the draft emails are send.
I tried changing this line but it did not work.
For lDraftCount = Drafts.Count To 99 Step -1
Set DraftItem = Drafts.Item(lDraftCount)

0
0
Reply
Dom Fino (@guest_203531)
December 23, 2016 10:23 am
#203531

I use Access 2016 to send email with attachments to about 500 members. Access creates the email and sends it to the DRAFT folder in Outlook. Will the modified code below take the first 99 emails in DRAFT and send them. Then wait 30 minutes and take the next 99 emails in Draft and send them, until all the DRAFT folder emails are sent?

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 lDraftCount As Long

Set olApp = Outlook.Application
Set NS = olApp.GetNamespace("MAPI")

Set DraftsFolder = NS.GetDefaultFolder(olFolderDrafts)
Set Drafts = DraftsFolder.Items

'Loop through all Draft Items
For lDraftCount = Drafts.Count To 99 Step -1
Set DraftItem = Drafts.Item(lDraftCount)

'Send Item
DraftItem.Send

End If
Next lDraftCount

'Clean-up

Set DraftsFolder = Nothing
Set NS = Nothing
Set olApp = Nothing

End Sub

0
0
Reply
Dom Fino (@guest_203530)
December 23, 2016 10:14 am
#203530

This is outstanding. I have an access data base that generates email to 500 members with attachments and sends the emails to the Draft folder in Outlook 2016.. I want to modify your code to only send the first 99 emails then pause for 30 minutes and resume to task taking the next 99 emails and send them etc.

I think I can modify your code to do this by eliminating some lines and changing a few others.

`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 lDraftCount As Long

Set olApp = Outlook.Application
Set NS = olApp.GetNamespace("MAPI")

Set DraftsFolder = NS.GetDefaultFolder(olFolderDrafts)
Set Drafts = DraftsFolder.Items

'Loop through all Draft Items
For lDraftCount = Drafts.Count To 99 Step -1
Set DraftItem = Drafts.Item(lDraftCount)

'Send Item
DraftItem.Send
Next lDraftCount

'Clean-up

Set DraftsFolder = Nothing
Set NS = Nothing
Set olApp = Nothing

End Sub

0
0
Reply
Dan (@guest_201667)
September 18, 2016 8:34 am
#201667

Dear Diana,
The following line gives an error when a message is being saved in Drafts with no subject line:

DraftItem.Subject = Right(DraftItem.Subject, Len(DraftItem.Subject) - 12)

I used the On Error Resume Next statement, but it does not work out.

0
0
Reply
Diane Poremsky(@diane-poremsky)
Author
Reply to  Dan
September 18, 2016 5:09 pm
#201671

the if line should tell the macro to skip it if the subject doesn't include the date field. oh, i bet it's not seeing the date as a number and it's greater than nothing.
use this after Set DraftItem line to kick it out of the subject is less than 12 (and therefore, doesn't have a date in the subject)
If Len(DraftItem.Subject) < 12 Then GoTo NextlDraftCount make this change so it jumps to the next message NextlDraftCount: Next lDraftCount

0
0
Reply
Dan (@guest_201682)
Reply to  Diane Poremsky
September 19, 2016 7:42 am
#201682

I am getting "Label is not defined" error.

0
0
Reply
Diane Poremsky(@diane-poremsky)
Author
Reply to  Dan
September 20, 2016 10:22 am
#201698

it highlights this : GoTo NextlDraftCount ?

did you add NextlDraftCount: before Next lDraftCount?
End If
NextlDraftCount:
Next lDraftCount

0
0
Reply
Dan (@guest_201139)
August 27, 2016 7:45 am
#201139

Dear Diana,
The code runs just great. May I ask if there a way to may this reminder Private Sub Application_Reminder(ByVal Item As Object) invisible? It flashes for a second or two and then disappears. I tried to use Application. ScreenUpdating = False but it did not work. Statement Item.Display = False gives error. Please advise.

0
0
Reply
Diane Poremsky(@diane-poremsky)
Author
Reply to  Dan
August 27, 2016 9:46 am
#201142

Screen updating false is Excel-only. You can dismiss the reminder and create a new task. The beforeremindershow event should eliminate the flash. The code sample at https://www.slipstick.com/developer/code-samples/running-outlook-macros-schedule/ shows how to dismiss reminders and recreate appointments - the same process would work for tasks.

If the task ran once day (or you used a series of tasks), you could use recurring tasks - mark the task complete (using .Complete) so the next one is generated.

0
0
Reply
Dan (@guest_201166)
Reply to  Diane Poremsky
August 28, 2016 10:31 pm
#201166

Dear Diana,
Not sure how to use beforeremindershow event. Attemped Event.Beforeremindershow=False and this statement give an error. Also tried the combination Private Sub Application_Reminder_BeforeReminderShow(ByVal Item As Object, Cancel As Boolean) and this also did not work out.

0
0
Reply
Diane Poremsky(@diane-poremsky)
Author
Reply to  Dan
August 28, 2016 11:12 pm
#201167

See https://www.slipstick.com/developer/code-samples/running-outlook-macros-schedule/ - the macro on the page uses the event. You just need the olRemind_BeforeReminderShow sub (and the withevents that goes with it)

0
0
Reply
Dan (@guest_201666)
Reply to  Diane Poremsky
September 18, 2016 8:16 am
#201666

Dear Diana,

Alas, can you please give me more clue how to compile it? I tried to use olRemind_BeforeReminderShow sub, but it does seem to be working with Private Sub Application_Reminder(ByVal Item As Object)? Can you please give me hint how to combine them?

0
0
Reply
Diane Poremsky(@diane-poremsky)
Author
Reply to  Dan
September 20, 2016 10:37 am
#201699

you need the private withevents line, the beforeremindershow sub and this much of the app reminder macro:

Private Sub Application_Reminder(ByVal Item As Object)
Set olRemind = Outlook.Reminders
End Sub

Tip: if you don't use the if caption line (or something similar to identify the correct reminder), the oldest reminder is dismissed, not the one that just fired.

0
0
Reply

Visit Slipstick Forums.
What's New at Slipstick.com

Latest EMO: Vol. 28 Issue 11

Support Services

Do you need help setting up Outlook, moving your email to a new computer, migrating or configuring Office 365, or just need some one-on-one assistance?

Subscribe to Exchange Messaging Outlook






Our Sponsors

CompanionLink
ReliefJet
  • Popular
  • Latest
  • WeekMonthAll
  • Adjusting Outlook's Zoom Setting in Email
  • How to Remove the Primary Account from Outlook
  • Cannot add Recipients in To, CC, BCC fields on MacOS
  • Move an Outlook Personal Folders .pst File
  • Save Sent Items in Shared Mailbox Sent Items folder
  • Create rules that apply to an entire domain
  • Outlook's Left Navigation Bar
  • Use PowerShell to get a list of Distribution Group members
  • View Shared Calendar Category Colors
  • Remove a password from an Outlook *.pst File
  • Cannot add Recipients in To, CC, BCC fields on MacOS
  • Change Appointment Reminder Sounds
  • Messages appear duplicated in message list
  • Reset the New Outlook Profile
  • Delete Old Calendar Events using VBA
  • Use PowerShell or VBA to get Outlook folder creation date
  • Outlook's Left Navigation Bar
  • Contact's Display Bug
  • Use PowerShell to get a list of Distribution Group members
  • Edit Outlook’s Attach File list
Ajax spinner

Newest Code Samples

Delete Old Calendar Events using VBA

Use PowerShell or VBA to get Outlook folder creation date

Rename Outlook Attachments

Format Images in Outlook Email

Set Outlook Online or Offline using VBScript or PowerShell

List snoozed reminders and snooze-times

Search your Contacts using PowerShell

Filter mail when you are not the only recipient

Add Contact Information to a Task

Process Mail that was Auto Forwarded by a Rule

Recent Bugs List

Microsoft keeps a running list of issues affecting recently released updates at Fixes or workarounds for recent issues in Outlook for Windows.

Outlook for Mac Recent issues: Fixes or workarounds for recent issues in Outlook for Mac

Office Update History

Update history for supported Office versions is at Update history for Office

Outlook Suggestions and Feedback

Outlook Feedback covers Outlook as an email client, including Outlook Android, iOS, Mac, and Windows clients, as well as the browser extension (PWA) and Outlook on the web.

Use Outlook.com Feedback for suggestions or feedback about Outlook.com accounts.

Other Microsoft 365 applications and services




Windows 10 Issues

  • iCloud, Outlook 2016, and Windows 10
  • Outlook Links Won’t Open In Windows 10
  • Outlook can’t send mail in Windows 10: error Ox800CCC13
  • Missing Outlook data files after upgrading Windows?

Outlook Top Issues

  • The Windows Store Outlook App
  • The Signature or Stationery and Fonts button doesn’t work
  • Outlook’s New Account Setup Wizard
  • Outlook 2016: No BCM
  • Exchange Account Set-up Missing in Outlook 2016

VBA Basics

How to use the VBA Editor

Work with open item or selected item

Working with All Items in a Folder or Selected Items

VBA and non-default Outlook Folders

Backup and save your Outlook VBA macros

Get text using Left, Right, Mid, Len, InStr

Using Arrays in Outlook macros

Use RegEx to extract message text

Paste clipboard contents

Windows Folder Picker

Custom Forms

Designing Microsoft Outlook Forms

Set a custom form as default

Developer Resources

Developer Resources

Developer Tools

Outlook-tips.net Samples

VBOffice.net samples

SlovakTech.com

Outlook MVP David Lee

MSDN Outlook Dev Forum

Repair PST

Convert an OST to PST

Repair damaged PST file

Repair large PST File

Remove password from PST

Merge Two Data Files

Sync & Share Outlook Data

  • Share Calendar & Contacts
  • Synchronize two computers
  • Sync Calendar and Contacts Using Outlook.com
  • Sync Outlook & Android Devices
  • Sync Google Calendar with Outlook
  • Access Folders in Other Users Mailboxes

Contact Tools

Data Entry and Updating

Duplicate Checkers

Phone Number Updates

Contact Management Tools

Diane Poremsky [Outlook MVP]

Make a donation

Calendar Tools

Schedule Management

Calendar Printing Tools

Calendar Reminder Tools

Calendar Dates & Data

Time and Billing Tools

Meeting Productivity Tools

Duplicate Remover Tools

Mail Tools

Sending and Retrieval Tools

Mass Mail Tools

Compose Tools

Duplicate Remover Tools

Mail Tools for Outlook

Online Services

Productivity

Productivity Tools

Automatic Message Processing Tools

Special Function Automatic Processing Tools

Housekeeping and Message Management

Task Tools

Project and Business Management Tools

Choosing the Folder to Save a Sent Message In

Run Rules on messages after reading

Help & Suggestions

Outlook Suggestion Box (UserVoice)

Slipstick Support Services

Home | Outlook User | Exchange Administrator | Office 365 | Outlook.com | Outlook Developer
Outlook for Mac | Common Problems | Utilities & Addins | Tutorials
Outlook & iCloud Issues | Outlook Apps
EMO Archives | About Slipstick | Advertise | Slipstick Forums
Submit New or Updated Outlook and Exchange Server Utilities

Send comments using our Feedback page
Copyright © 2023 Slipstick Systems. All rights reserved.
Slipstick Systems is not affiliated with Microsoft Corporation.

wpDiscuz

Sign up for Exchange Messaging Outlook

Our weekly Outlook & Exchange newsletter (bi-weekly during the summer)






Please note: If you subscribed to Exchange Messaging Outlook before August 2019, please re-subscribe.

Never see this message again.

You are going to send email to

Move Comment