How to set reminder for incoming or outgoing meeting requests - vba

Question

When I create/update meeting requests OR receive a meeting request (skype/team meeting or regular meeting), I want to check if a reminder has been set. If not, set a reminder for 15 minutes before the meeting.
Some searching brought me code I included in the "ThisOutlookSession" module. No reminders are added.
Public WithEvents objCalendar As Outlook.Folder
Public WithEvents objCalendarItems As Outlook.Items
Private Sub Application_Startup()
Set objCalendar = Outlook.Application.Session.GetDefaultFolder(olFolderCalendar)
Set objCalendarItems = objCalendar.Items
End Sub
Private Sub objCalendarItems_ItemAdd(ByVal Item As Object)
Call SetReminder(Item)
End Sub
Private Sub objCalendarItems_ItemChange(ByVal Item As Object)
Call SetReminder(Item)
End Sub
Private Sub SetReminder(ByVal objCalendarItem As Object)
If TypeOf Item Is MeetingItem Then
Set objMeetingRequest = Item
Set objMeeting = objMeetingRequest.GetAssociatedAppointment(True)
'Check if reminder existing
If objMeeting.ReminderSet = False Then
objMeeting.ReminderSet = True
objMeeting.ReminderMinutesBeforeStart = 15
objMeeting.Save
End If
End If
End Sub

Answer 1

First of all, there is no Item object passed to the SetReminder method.
You need to check for AppointmentItem instead of MeetingItem in the code.
Private Sub SetReminder(ByVal objCalendarItem As Object)
Dim objMeeting as AppointmentItem
If TypeOf objCalendarItem Is AppointmentItem Then
Set objMeeting = objCalendarItem
'Check if reminder existing
If objMeeting.ReminderSet = False Then
objMeeting.ReminderSet = True
objMeeting.ReminderMinutesBeforeStart = 15
objMeeting.Save
End If
End If
End Sub
If required you may check out the MeetingStatus property.