VBA how to event handle ItemAdd & ItemChange both (in Outlook Calendar) for iCloud Calendar folder

42 views Asked by At

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.

0

There are 0 answers