Outlook using excel VBA

Question

I have the following which deletes a given Outlook appointment by subject name.

I am looking to keep the appointment but rescind the prior invite I have sent to certain users. I have these users in columns B rows 5 - 15 ieB1:B15. So I need to loop through these users and send a rescind/cancel to the prior invite to the appointment.

    Dim olApp As Outlook.Application
    Dim objAppointment As Outlook.Appointment
    Dim objAppointments As Outlook.MAPIFolder
    Dim objNameSpace As Outlook.NameSpace
    Dim ObjProperty As Outlook.UserProperty
    Dim FilterString As String

    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = ol.App.getNameSpace.GetDefaultFolder(olFolderCalendar)

    Title = Range("A1").Value

    FilterString = "[Subject]" = '" & Title & '"
    
    Set objAppointment = objAppointment.Items.Find(FilterString)

    If Not TypeName(objAppointment) = "Nothing" Then
        objAppointment.Delete
    End If

    Set objAppointment = Nothing
    Set objAppointments = Nothing

End Sub

Answer 1

I do not know too much about VBA on the Outlook side but I recently came across this post which helped me. I don't know if the answers in this post meet your expectations or if you can reuse the code.

Outlook meeting cancelling using VBA

Answer 2

The code that I am posting is working just fine. It's commented, so you should have no problems to understand.

If the filter results is different from 1 then procedure will exit, but it is prepared do work with more than one result found.

The procedure will delete all the attendees except the organizer first then it will add the attendees that have the value '1' in column 'C'.

The attendee range in column 'B' is dynamic.

Sub SearchAppt()
    Dim olApp As Outlook.Application
    Dim objNameSpace As Outlook.Namespace
    Dim CalendarItems As Outlook.Items
    Dim Item As Outlook.AppointmentItem
    Dim RestrictedItems As Outlook.Items
    Dim FilterString As String
           
    On Error GoTo errHandler
    
    Set olApp = CreateObject("Outlook.Application")
    Set objNameSpace = olApp.GetNamespace("MAPI")
    Set CalendarItems = objNameSpace.GetDefaultFolder(olFolderCalendar).Items
    
    ' Filter calendar by subject: Example searching for apptoint that contains Strategy
    FilterString = "@SQL=""urn:schemas:httpmail:subject"" LIKE '%Strategy%'"
    
    ' Restricted items
    Set RestrictedItems = CalendarItems.Restrict(FilterString)
    
    ' Count mails found
    Dim nMailsFound As Double: nMailsFound = RestrictedItems.Count
    
    ' If the filter results count is different from 1 then exit
    If nMailsFound <> 1 Then GoTo exitRoutine
    
    ' Display info from items found
    Dim Attendee, myOptionalAttendee As Outlook.Recipient
    
    ' Range for attendees (dynamic)
    Dim attendeeRng As Range: Set attendeeRng = ActiveSheet.Range(Range("B1"), Range("B1").End(xlDown))
    Dim rCell As Range
    
    For Each Item In RestrictedItems
        If Item.Class = olAppointment Then
            ' Delete all attendees except Organizer
            For Each Attendee In Item.Recipients
                If Attendee.Name <> Item.Organizer Then
                    Attendee.Delete
                End If
            Next Attendee
              
            For Each rCell In attendeeRng
                If rCell.Value <> Item.Organizer And rCell.Offset(0, 1).Value = 1 Then
                    ' Add attendee
                    Set myOptionalAttendee = Item.Recipients.Add(rCell.Value): myOptionalAttendee.Type = olRequired
                    'Set myOptionalAttendee = Item.Recipients.Add("attendee_02"): myOptionalAttendee.Type = olOptional
                End If
            Next rCell
            
            ' Send Update
            Item.Send
        End If
    Next Item
    
exitRoutine:
    Set olApp = Nothing
    Exit Sub
    
errHandler:
    Debug.Print Err.Description
    Resume exitRoutine
End Sub