Send an email when you add an appointment to your calendar

Last reviewed on September 15, 2014

An Outlook Calendar owner wanted to know how to notify a delegate that a new appointment was scheduled when adding an appointment to the calendar. Solution: VBA that watches for a new appointment item and sends an email to a predetermined email address.

Generate an email when you create an appointment

To avoid sending email for personal appointments, the VBA looks for a category named "private" and only sends an email if that category is NOT assigned to the appointment. You could use a subject filter to check for the word Private as the first word in the subject instead:

If Item.Class = olAppointment And _ 
    Left(Item.Subject, 8) <> "Private:" Then 

With a little tweaking, the delegate could generate the email to the boss when she adds a new appointment to the boss's calendar.

Send an Email when a New Appointment is added to Calendar

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Set Ns = Application.GetNamespace("MAPI")
  Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
  On Error Resume Next

If Item.Class = olAppointment And _
   Item.Categories <> "private" Then

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

   objMsg.To = "alias@domain.com"
   objMsg.Subject = Item.Subject
   objMsg.Body = "New appointment added to " & Item.Organizer & "'s calendar." & _
     vbCrLf & "Subject: " & Item.Subject & "     Location: " & Item.Location & _
     vbCrLf & "Date and time: " & Item.Start & "     Until: " & Item.End
   
'use Display instead of Send if you want to add a note before sending
   objMsg.Send

   Set objMsg = Nothing

   End If

End Sub

Watching for new items in a non-default calendars

If the calendar is not your default calendar, you need to use the Function for non-default folders at Working with VBA and non-default Outlook Folders.

After adding the GetFolderPath function to the module, change
Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
to
Set Items = GetFolderPath("other-datafile-display-name\Calendar").Items

Don't forget to change the display name to the name that is used in the folder list.

Watch for new appointments in a Shared Calendar

To watch for updates in a shared calendar (Exchange Server), you need to resolve the recipient and use GetSharedDefaultFolder. Replace the Application_Startup macro with this, using the shared mailbox's display name as it appears in the GAL.

Private Sub Application_Startup()
  Dim Ns As Outlook.NameSpace
  Dim CalendarFolder As Outlook.Folder
  Dim objOwner As Outlook.Recipient
  
  Set Ns = Application.GetNamespace("MAPI")
  Set objOwner = Ns.CreateRecipient("Mary Contrary")
    objOwner.Resolve
     
 'MsgBox objOwner.Name

 If objOwner.Resolved Then

  Set CalendarFolder = Ns.GetSharedDefaultFolder(objOwner, olFolderCalendar)
  Set Items = CalendarFolder.Items
 End If

End Sub

Watch for Updates

To watch for updates, you'll use the same code in a procedure named Private Sub Items_ItemChange(ByVal Item As Object). If you are watch for new or updated items, add this code to the module after the ItemAdd code above. If you are only watching for the ItemChange event, you need to use the Application_Startup and declaration code from above. (Or use the code above and change ItemAdd to ItemChange.)


Private Sub Items_ItemChange(ByVal Item As Object)
  On Error Resume Next
 
If Item.Class = olAppointment Then
 
  Dim objMsg As MailItem
   Set objMsg = Application.CreateItem(olMailItem)
 
   objMsg.To = "alias"
   objMsg.Subject = Item.Subject
   objMsg.Body = "Appointment changed " & Item.Organizer & "'s calendar." & _
     vbCrLf & "Subject: " & Item.Subject & "     Location: " & Item.Location & _
     vbCrLf & "Date and time: " & Item.Start & "     Until: " & Item.End
    
'use Display instead of Send if you want to add a note before sending
   objMsg.Display
 
   Set objMsg = Nothing
 
   End If
 
End Sub

Written by

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.

Please post long or more complicated questions at Outlookforums.

40 responses to “Send an email when you add an appointment to your calendar”

  1. Neil Sams

    Sorry,
    I cannot get this to work?

  2. Joseph

    How can I get this to work with a script in the rules? I want an email automatically sent to the sender with a message in the body of my email only when I have a calendar event set to "Out of Office" during the time the email was sent to me.

    Thanks!

  3. Josh

    How can I make this work to also notify of appointment removal or changes?

  4. Josh

    Thanks Diane. I was able to make the ItemChange function work, but it is sending three emails for every change. Thoughts? Note: This is not my default calendar. It is a secondary calendar that I have shared.

  5. Mike

    Hello Diane. Thanks for the code. However, I am struggling to get the If... Then statement to filter correctly. I would like an email sent only when the new appointment has a certain category set. I'm using this code:-

    If Item.Class = olAppointment And Items.Categories = "Book" Then

    Unfortunately, the script sends an email regardless of the category set.

    Any ideas?
    Thanks!

  6. Mike

    Thank you for the swift reply. Using Item.Categories the code works. I've run into a slightly different problem. If the appointment has more than one category assigned to it e.g. Book and Internal then it seems that the script ignores it. Is this right and is there a way to send an email for any appointment that has the "Book" category set?

    The If ... then statement I'm using looks like this:-

    If Item.Class = olAppointment And Item.Categories = "Book" Then

    Thanks in advance.
    Mike

  7. Austin Knobloch

    I am having trouble getting this implemented. I added this code as a "Class Module," but when I add an event nothing happens...Any help would be appreciated!

  8. Austin

    I guess I should of stated my goal. I have a Public Calendar in the Public Folders that I want to get email notifications when anything is added or changed.
    thanks.

  9. Lori

    Hello Diane, I am not a developer and concerned with inputting code that I'm not familiar with. I am wondering if you can help a novice set this up so any time I add a "personal" calendar item to my "personal" Outlook calendar, either via iphone/ipad/laptop, it automatically sends an email to my work email address. More and more I want to keep work and personal separate. This way I can create a separate personal calendar at work, from the emails I would send myself, which no one has access to, and overlay it with my work calendar to identify any conflicts, etc. Perhaps if you can tell me which elements in the code above need to be customized, I can do this myself.

  10. yodelayheewho

    Diane,
    I tried to run the macro (below) and I got this message: "The macros in this project are disabled. Please refer to online help or documentation of the host application to determine how to enable macros."

    I found a tip on the Internet suggesting I digitally sign the macro. So, I did. I closed Outlook 2013 and opened it again. And got the message above.

    My Macro Settings in the Trust Center are: "Notifications for digitally signed macros, all other macros disabled."

    Another tip was to change the Macro Settings in the Trust Center to: "Enable all macros..." I am not comfortable with this as it may be 'potentially dangerous'.

    Here's the code I have:

    Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
    End Sub
    Private Sub Items_ItemAdd(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

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

    objMsg.To = "work email address here"
    objMsg.Subject = Item.Subject
    objMsg.Body = "New appointment added to My personal calendar" & Item.Organizer & "My work calendar." & _
    vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    'use Display instead of Send if you want to add a note before sending
    objMsg.Send

    Set objMsg = Nothing

    End If

    End Sub

    Private Sub Items_ItemChange(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

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

    objMsg.To = "work email address here"
    objMsg.Subject = Item.Subject
    objMsg.Body = "Appointment changed on My personal calendar" & Item.Organizer & "My work calendar." & _
    vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    'use Display instead of Send if you want to add a note before sending
    objMsg.Send

    Set objMsg = Nothing

    End If

    End Sub

    Any suggestions?

  11. yodelayheewho

    Diane,

    Now, when I close and reopen Outlook 2013, I get the following message:
    "This file contains macros with an expired or revoked signature. Since you are running under High Security Level, these macros will be disabled."

  12. Lauren

    Diane,

    I can't get it to work at all for whatever reason. I don't have the option to "run" after I input the code in a module. Suggestions?

    Thanks!

  13. Darryl

    Diane,

    I have copied and pasted the script into ThisOutlookSession and when I click the save button and then try to run it, it pulls up the Macros box and there is nothing to select to run. What am I missing here? This is my first time working with scripts. Thank you.

  14. saju

    Hi Diane

    Is there a way to get notified by email whenever a change is made in a shared calendar by some one else? I understand that the above codes are for sending emails to others when one tries to create a new appointment or updates an already existing appointment in a shared calendar.

  15. yodelayheewho

    Hi Diane,

    I finally was able to hit 'run' and get no error messages for the following code (I substituted my work email address and my name with the word "alias").

    I ran a test, creating an appointment in Outlook 2013 on my home PC laptop with my work PC laptop next to me, with Outlook 2010 open. I never received an email notifying me that I scheduled an appointment on my home PC:(

    I feel like I'm so close to solving this. What am I missing?

    Private Sub Application_Startup()
    Dim Ns As Outlook.NameSpace
    Set Ns = Application.GetNamespace("MAPI")
    Set Items = Ns.GetDefaultFolder(olFolderCalendar).Items
    End Sub
    Private Sub Items_ItemAdd(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

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

    objMsg.To = "alias"
    objMsg.Subject = Item.Subject
    objMsg.Body = "New appointment added to alias's personal calendar" & Item.Organizer & "alias's work calendar." & _
    vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    'use Display instead of Send if you want to add a note before sending
    objMsg.Send

    Set objMsg = Nothing

    End If

    End Sub

    Private Sub Items_ItemChange(ByVal Item As Object)
    On Error Resume Next

    If Item.Class = olAppointment Then

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

    objMsg.To = "alias"
    objMsg.Subject = Item.Subject
    objMsg.Body = "Appointment changed on alias's personal calendar" & Item.Organizer & "alias's work calendar." & _
    vbCrLf & "Subject: " & Item.Subject & " Location: " & Item.Location & _
    vbCrLf & "Date and time: " & Item.Start & " Until: " & Item.End

    'use Display instead of Send if you want to add a note before sending
    objMsg.Send

    Set objMsg = Nothing

    End If

    End Sub

    Sub HomeCalendarEMailedToWorkCalendar()

    End Sub

  16. yodelayheewho

    Hi Diane,

    I changed the objmsg.send line to objmsg.display.

    Then, when I add Private WithEvents Items As Outlook.Items to the very first line. It turns red and I get the following error message: "Compile error: Only valid in object module".

    I click ok to get rid of the error message.

    When I try to click Run, then the macro dialog box pops up asking me to name the macro. So, I named it: HomeCalendarEMailedToWorkCalendar and it places the following underneath all of the code:

    Sub HomeCalendarEMailedToWorkCalendar()

    End Sub

  17. Jami Backer

    I'm currently using this code and it's working beautifully. I do however wonder if there is more code to add that would make the notification email appear in red. Thanks!

  18. hello123

    I am not able to run the code "Send an Email when a New Appointment is added to Calendar". It says error in the first line at "private WithEvents.......". Could anyone solve this issue since its quite urgent.

  19. Chris

    Brilliant.

    A "me too" on the sending three times on update.

    I tweaked the original to send as vcs file, so can be accepted by my gmail calendar

    Private Sub Items_ItemAdd(ByVal Item As Object)
    Dim oForward As MailItem

    If TypeName(Item) = "AppointmentItem" Then
    'Forward the appointment
    Set oForward = Item.ForwardAsVcal
    oForward.Recipients.Add ("bob@gmail.com")

    'Send it
    oForward.Send
    Set oForward = Nothing
    End If

Leave a Reply

If the Post Coment button disappears, press your Tab key.