Send an Email When a Reminder Fires

Chia sẻ bởi:hands

★★★★★

‹ Use a macro to move Sent Items Saving All Messages to the Hard Drive... ›

Quảng cáo

Another entry in my Lazy Programmer Series, this time I have a macro that sends an email message when a reminder fires. This macro was the result of a request for the ability to send messages to the sales team each morning with the day's agenda.

If you prefer to use an add-in, I have a list of reminder tools at
[URL='www.slipstick.com/outlook/outlook-reminders-focus/']"Outlook Reminders Don't Come into Focus"

You can use the macro to send yourself reminders or even to compose an email message ahead of time (in the body of a an appointment form) and send it later. Outlook will need to be running and be able to connect to the mail server for the message to be generated and sent.

Because the message is composed when the reminder fires, the message time stamp will be the reminder time. Please don't abuse the trust others have in you: use this macro for legitimate purposes, not to convince someone you were working when you weren't!

Outlook needs to be running for these macros to work. Note, this will trigger the email security alert in older versions of Outlook. Use one of the tools listed at the end to dismiss the dialogs.

To use, press Alt+F11 to open the VBA editor then copy the code and paste it into ThisOutlookSession.

Send a message to someone when a reminder fires

This macro checks for Appointment reminders and sends a message to the value in the location field. For this to be useful, you need to use a category, otherwise Outlook will attempt to send a message with every appointment reminder.

Private Sub Application_Reminder(ByVal Item As Object)
  Dim objMsg As MailItem

'IPM.TaskItem to watch for Task Reminders
If Item.Messaghocexcel <> "IPM.Appointment" Then
  Exit Sub
End If

If Item.Categories <> "Send Message" Then
  Exit Sub
End If

Set objMsg = Application.CreateItem(olMailItem)
With objMsg
  .To = Item.Location
  .BCC = "me@slipstick.com"
  .Subject = Item.Subject
  .Body = Item.Body
  .Send
End With
  Set objMsg = Nothing
End Sub

To use a template instead of the default message form, replace Set objMsg = Application.CreateItem(olMailItem) with Set objMsg = Application.CreateItemFromTemplate("C:pathtotest-rule.oft")

[URL='www.slipstick.com/developer/send-email-outlook-reminders-fires/#yourself']

Send a message to yourself when a reminder fires

This is the original code we had on this page and sends an email message to an address when any reminder fires.

Private Sub Application_Reminder(ByVal Item As Object)
  Dim objMsg As MailItem

Set objMsg = Application.CreateItem(olMailItem)

objMsg.To = "alias@domain.com"
  objMsg.Subject = "Reminder: " & Item.Subject

' Code to handle the 4 types of items that can generate reminders
  Select Case Item.Class
     Case olAppointment '26
        objMsg.Body = _
          "Start: " & Item.Start & vbCrLf & _
          "End: " & Item.End & vbCrLf & _
          "Location: " & Item.Location & vbCrLf & _
          "Details: " & vbCrLf & Item.Body
     Case olContact '40
        objMsg.Body = _
          "Contact: " & Item.FullName & vbCrLf & _
          "Phone: " & Item.BusinessTelephoneNumber & vbCrLf & _
          "Contact Details: " & vbCrLf & Item.Body
      Case olMail '43
        objMsg.Body = _
          "Due: " & Item.FlagDueBy & vbCrLf & _
          "Details: " & vbCrLf & Item.Body
      Case olTask '48
        objMsg.Body = _
          "Start: " & Item.StartDate & vbCrLf & _
          "End: " & Item.DueDate & vbCrLf & _
          "Details: " & vbCrLf & Item.Body
  End Select

objMsg.Send
  Set objMsg = Nothing
End Sub

Change the From account

This macro sets the From field to use a different account in your profile.

Private Sub Application_Reminder(ByVal Item As Object)
  Dim olNS As Outlook.NameSpace
  Dim objMsg As MailItem

'IPM.TaskItem to watch for Task Reminders
If Item.Messaghocexcel <> "IPM.Appointment" Then
  Exit Sub
End If

If Item.Categories <> "Send Message" Then
  Exit Sub
End If

Set olNS = Application.GetNamespace("MAPI")
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
' based on the list in Account Settings
   .SendUsingAccount = olNS.Accounts.Item(1)
  .To = Item.Location
  .BCC = "me@slipstick.com"
  .Subject = Item.Subject
  .Body = Item.Body
  .Send
End With
  Set objMsg = Nothing
End Sub

Send a message to all attendees

This version of the macro sends a reminder to all attendees. As written, it does not check to see if the attendee accepted or declined, but the macro could do that. I have sample code at [URL='www.slipstick.com/developer/list-meeting-attendees-responses/']Create a List of Meeting Attendees and Responses which creates a list of attendees and their responses that shows how to get this information.

Private Sub Application_Reminder(ByVal Item As Object)
  Dim objMsg As MailItem

If Item.Messaghocexcel <> "IPM.Appointment" Then
  Exit Sub
End If

'If Item.Categories <> "Send Message" Then
'  Exit Sub
'End If

' Get The Attendee List
Dim objAttendees As Outlook.Recipients
Dim objAttendeeReq As String
Dim objAttendeeOpt As String
Dim objOrganizer As String

Set objAttendees = Item.Recipients

For x = 1 To objAttendees.Count

If objAttendees(x).Type = olRequired Then
      objAttendeeReq = objAttendees(x) & ";" & objAttendeeReq
   ElseIf objAttendees(x).Type = olOptional Then
      objAttendeeOpt = objAttendees(x) & ";" & objAttendeeOpt
   End If
Next

Debug.Print objAttendeeReq, objAttendeeOpt
  Set objMsg = Application.CreateItem(olMailItem)
With objMsg
  .To = objAttendeeReq
  .CC = objAttendeeOpt
  .Subject = Item.Subject
  .Body = Item.Body
  .Send
End With

Set objMsg = Nothing
End Sub

Send a Draft when a Reminder Fires

This macro sends a draft message when a reminder fires. This allows you to use more formatting and HTML features in the message.

To use: Create the message and save it. Copy the subject line. Create the appointment, pasting the subject in the Location field. Set the appointment for the date and time you want the draft sent.

Adapted from "[URL='www.slipstick.com/developer/scheduling-drafts-in-outlook/']Scheduling Drafts in Outlook"

Private Sub Application_Reminder(ByVal Item As Object)
  Dim objMsg As MailItem
  Set objMsg = Application.CreateItem(olMailItem)

'IPM.TaskItem to watch for Task Reminders
If Item.Messaghocexcel <> "IPM.Appointment" Then
  Exit Sub
End If

If Item.Categories <> "Send Message" Then
  Exit Sub
End If

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 DraftsFolder = Session.GetDefaultFolder(olFolderDrafts)
Set Drafts = DraftsFolder.Items

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

If DraftItem.Subject = Item.Location Then
'Send Item
  DraftItem.Send
End If

Next lDraftCount

'Clean-up
Set DraftsFolder = Nothing
Set objMsg = Nothing
End Sub

Select an appointment and send a message

With a few tweaks, the macro above can be used to send a message by selecting the appointment then running the macro.

Press Alt+F11 to open the VBA editor.
Right click on Project1 and choose Insert > Module.
Paste the code below into the Module.
Get the GetCurrentItem function from [URL='www.slipstick.com/developer/outlook-vba-work-with-open-item-or-select-item/']Outlook VBA: work with open item or selected item and paste it into the module.

Public Sub App_Reminder()
  Dim Item As AppointmentItem
  Dim objMsg As MailItem
  Set objMsg = Application.CreateItem(olMailItem)

Set Item = GetCurrentItem()

With objMsg
'  .To = Item.Location
  .Subject = Item.Subject
  .Body = Item.Body
  .Display ' use .Send to send it instead
End With

Set objMsg = Nothing
Set Item = Nothing

End Sub

Dismiss the Reminder (and send a message)

This version of the macro dismisses the reminder when it comes up and sends the message. To do this, we need to use the BeforeReminderShow method and declare olRemind and strSubject outside of the macro.

Private WithEvents olRemind As Outlook.Reminders
Dim strSubject As String

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

'IPM.TaskItem to watch for Task Reminders
If Item.Messaghocexcel <> "IPM.Appointment" Then
  Exit Sub
End If

If Item.Categories <> "Send Message" Then
  Exit Sub
End If

strSubject = Item.Subject
  Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)

objMsg.To = Item.Location
  objMsg.BCC = "me@slipstick.com"
  objMsg.Subject = strSubject
  objMsg.Body = Item.Body
  objMsg.Send

Set objMsg = Nothing

End Sub

Private Sub olRemind_BeforeReminderShow(Cancel As Boolean)

For Each objRem In olRemind
            If objRem.Caption = strSubject Then
                If objRem.IsVisible Then
                    objRem.Dismiss
                    Cancel = True
                End If
                Exit For
            End If
        Next objRem

End Sub

Pop up a dialog

You can use the code on this page to do pretty much anything VBA can do when the reminder fires.
cdn.slipstick.com/images/reminder-msgbox.png

This simple code sample displays a dialog box to remind you.

Private Sub Application_Reminder(ByVal Item As Object)

If Item.Messaghocexcel <> "IPM.Appointment" Then
  Exit Sub
End If

MsgBox "You have an appointment for " & vbCrLf _
  & Item.Subject & vbCrLf _
  & "on " & Format(Item.Start, "mmm dd") & vbCrLf _
  & "Time: " & Format(Item.Start, "hh:mm AM/PM") _
  & vbCrLf & "Location: " & Item.Location

End Sub

Video Tutorial

m0NJG51culE

How to use the macro

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. If Outlook tells you it needs to be restarted, close and reopen Outlook. Note: after you test the macro and see that it works, you can either leave macro security set to low or [URL='www.slipstick.com/developer/how-to-use-outlooks-vba-editor/']sign the macro.

Now open the VBA Editor by pressing Alt+F11 on your keyboard.

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.)

Application_Startup macros run when Outlook starts. If you are using an Application_Startup macro you can test the macro without restarting Outlook by clicking in the first line of the Application_Startup macro then clicking the Run button on the toolbar or pressing F8.

More information as well as screenshots are at [URL='www.slipstick.com/developer/how-to-use-outlooks-vba-editor/']How to use the VBA Editor.

[URL='www.slipstick.com/developer/send-email-outlook-reminders-fires/#tools']

Tools

[URL='www.contextmagic.com/express-clickyes/pro-version.htm']ClickYes Pro

ClickYes Pro is a tuning tool for Microsoft Outlook security settings. It allows you to configure which applications can automatically send emails using Outlook and access email addresses stored in Outlook address book. ClickYes Pro runs as a background task providing a convenient icon in the taskbar notification area to manage allowed applications. It uses an encrypted storage and is highly secure and safe. Client and Server versions available. Works with Outlook 2000 – Outlook 2010.

[URL='www.mapilab.com/dev/outlook_security/']Outlook Security Manager

Developers can use this to avoid the security prompts in Outlook.

More Information
[URL='www.slipstick.com/outlook/tasks/open-webpage-task-reminder-fires/']Open a webpage when a Task reminder fires
To send an email daily using a Task, see [URL='https://www.vboffice.net/en/developers/send-emails-automatically']E-Mail: Send daily (vboffice.net)

www.slipstick.com/developer/send-email-outlook-reminders-fires/