This question is based on the StackOverflow question VBA how to event handle ItemAdd & ItemChange both (for Outlook 2016 Calendar)?.
That question asks how to display a msgbox every time a new Calendar item was placed in the default Outlook Calendar folder. I have altered the code so that it works in non-default Outlook Calendar folders, except that it does not work for the iCloud Calendar folder (\iCloud\Calendar).
Option Explicit
'Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items
Private WithEvents objItems2 As Outlook.Items
Private Sub Application_Startup()
'Dim objWatchFolder As Outlook.Folder
Dim objCalendarFolder As Outlook.Folder
Dim strCalendarFolderName As String
strCalendarFolderName = "\\iCloud\Calendar"
'Set objNS = Application.GetNamespace("MAPI")
'Set the folder and items to watch:
'Set objWatchFolder = objNS.GetDefaultFolder(olFolderCalendar)
' Function GetCalendarObject is defined below.
Set objCalendarFolder = GetCalendarObject(strCalendarFolderName)
Set objItems = objCalendarFolder.Items
Set objItems2 = objCalendarFolder.Items
End Sub
Private Sub objItems_ItemAdd(ByVal Item As Object)
' Your code goes here
' MsgBox "Message subject: " & Item.Subject & vbCrLf & "Message sender: " & Item.SenderName & " (" & Item.SenderEmailAddress & ")"
' https://www.slipstick.com/developer/itemadd-macro
MsgBox "*** PROPERTIES of olFolderCalendar ***" & vbNewLine & _
"Subject: " & Item.Subject & vbNewLine & _
"Start: " & Item.Start & vbNewLine & _
"End: " & Item.End & vbNewLine & _
"Duration: " & Item.Duration & vbNewLine & _
"Location: " & Item.Location & vbNewLine & _
"Body: " & Item.Body & vbNewLine & _
"Global Appointment ID: " & Item.GlobalAppointmentID
End Sub
Private Sub objItems2_ItemChange(ByVal Item As Object)
MsgBox "*** PROPERTIES of olFolderCalendar ***" & vbNewLine & _
"Subject: " & Item.Subject & vbNewLine & _
"Start: " & Item.Start & vbNewLine & _
"End: " & Item.End & vbNewLine & _
"Duration: " & Item.Duration & vbNewLine & _
"Location: " & Item.Location & vbNewLine & _
"Body: " & Item.Body & vbNewLine & _
"Global Appointment ID: " & Item.GlobalAppointmentID
End Sub
Private Function GetCalendarObject(FolderPath As String) As Outlook.Folder
' Outlook folders.
Dim oFolder As Outlook.Folder
Dim oSubFolder As Outlook.Folder
Dim oCalendar As Outlook.Folder
' Loop over all top-level folders.
For Each oFolder In Application.Session.Folders
' Loop over subfolders.
For Each oSubFolder In oFolder.Folders
If oSubFolder.DefaultItemType = olAppointmentItem Then
' Calendar folders only.
If oSubFolder.FolderPath = FolderPath Then
' Get object whose folder path is the desired folder path.
Set GetCalendarObject = oSubFolder
Exit For
End If
End If
Next
Next
If GetCalendarObject Is Nothing Then
MsgBox "Failed to find object for folder path " + FolderPath
End If
End Function
I have also tried setting strCalendarFolderName = "\\Tutoring\blarvitz" and restarting Outlook, where "\\Tutoring\blarvitz" is the name of another Calendar folder I created for testing purposes. I get a msgbox to pop up when I create calendar items in "\\Tutoring\blarvitz". But I do not get a msgbox to pop up when I set strCalendarFolderName = "\\iCloud\Calendar".
An acceptable alternative is to execute a macro when Outlook's New AppointmentItem window closes, but I don't know how to do that either.