Outlook meeting cancelling using VBA - vba

Question

There are instances when we forget to cancel a meeting which we scheduled, maybe due to absence of someone important, or maybe due to lack of time. But in many cases we forget to cancel the meeting from outlook. So, I am looking for a VBA code which will ask the organizer of a meeting if the meeting is good to go, or if it is to be cancelled, and will send out a cancellation mail if it is to be cancelled. Please help me with this. Thanks in advance! :)

Answer 1

After using the code from #alina as well as some other macro's from around the web, I came up with a solution for the same which i am sharing here.
Public WithEvents objReminders As Outlook.Reminders
Sub Initialize_handler()
Set objReminders = Application.Reminders
End Sub
Private Sub objReminders_ReminderFire(ByVal ReminderObject As reminder)
Dim oApp As Outlook.Application
Dim oNameSpace As Outlook.NameSpace
Dim oApptItem As Outlook.AppointmentItem
Dim oFolder As Outlook.MAPIFolder
Dim oMeetingoApptItem As Outlook.MeetingItem
Dim oObject As Object
Dim iUserReply As VbMsgBoxResult
Dim sErrorMessage As String
MsgBox (VBA.Time)
On Error Resume Next
' check if Outlook is running
Set oApp = GetObject("Outlook.Application")
If Err <> 0 Then
'if not running, start it
Set oApp = CreateObject("Outlook.Application")
End If
On Error GoTo Err_Handler
Set oNameSpace = oApp.GetNamespace("MAPI")
Set oFolder = oNameSpace.GetDefaultFolder(olFolderCalendar)
For Each oObject In oFolder.Items
If oObject.Class = olAppointment Then
Set oApptItem = oObject
If ReminderObject.Caption = oApptItem.Subject Then
If oApptItem.Organizer = Outlook.Session.CurrentUser Then
iUserReply = MsgBox("Meeting found:-" & vbCrLf & vbCrLf _
& Space(4) & "Date/time (duration): " & Format(oApptItem.Start, "dd/mm/yyyy hh:nn") _
& " (" & oApptItem.Duration & "mins)" & Space(10) & vbCrLf _
& Space(4) & "Subject: " & oApptItem.Subject & Space(10) & vbCrLf _
& Space(4) & "Location: " & oApptItem.Location & Space(10) & vbCrLf & vbCrLf _
& "Do you want to continue with the meeting?", vbYesNo + vbQuestion + vbDefaultButton1, "Meeting confirmation")
If iUserReply = vbNo Then
oApptItem.MeetingStatus = olMeetingCanceled
oApptItem.Save
oApptItem.Send
oApptItem.Delete
End If
End If
End If
End If
Next oObject
Set oApp = Nothing
Set oNameSpace = Nothing
Set oApptItem = Nothing
Set oFolder = Nothing
Set oObject = Nothing
Exit Sub
Err_Handler:
sErrorMessage = Err.Number & " " & Err.Description
End Sub

Answer 2

I found this here
Public Function DeleteAppointments(ByVal subjectStr As String)
Dim oOL As New Outlook.Application
Dim oNS As Outlook.NameSpace
Dim oAppointments As Object
Dim oAppointmentItem As Outlook.AppointmentItem
Dim iReply As VbMsgBoxResult
Set oNS = oOL.GetNamespace("MAPI")
Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
Count = oAppointments.Items.Count 'for test purposes
For Each oAppointmentItem In oAppointments.Items
If InStr(oAppointmentItem.Subject, subjectStr) > 0 Then
iReply = msgbox("Appointment found:" & vbCrLf & vbCrLf _
& Space(4) & "Date/time: " & Format(oAppointmentItem.Start, "dd/mm/yyyy hh:nn") & vbCrLf _
& Space(4) & "Subject: " & oAppointmentItem.Subject & Space(10) & vbCrLf & vbCrLf _
& "Delete this appointment?", vbYesNo + vbQuestion + vbDefaultButton2, "Delete Appointment?")
If iReply = vbYes Then oAppointmentItem.Delete
oAppointmentItem.Delete
End If
Next
Set oAppointmentItem = Nothing
Set oAppointments = Nothing
Set oNS = Nothing
Set oOL = Nothing
End Function