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.

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

Send message from Creator

If you have multiple users sharing the same calendar and set the macro up for each user, when the new calendar event syncs to each computer, multiple messages will be generated. To prevent this, use a properyaccessor to get the account name that created the appointment and compare it to the default email account name. If they match, generate the message.

This code watches the user's default calendar. See Working with VBA and non-default Outlook Folders if you need to watch a different 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

Dim CreatedByName 'As String
Dim pa As Outlook.propertyAccessor
Set olns = Application.GetNamespace("MAPI")
Set pa = Item.propertyAccessor
CreatedByName = pa.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3FFA001E")

If CreatedByName = olns.Accounts.Item(1) Then

'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." & "By " & CreatedByName & _
     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 'Send
 
   Set objMsg = Nothing
 
   End If
' End If
 Set olns = Nothing
End Sub