Add a recipient to an Outlook AppointmentItem then send only to added recipient

Question

I'm trying to parse through all my Calendar items and check if they are sent to specific recipients.
If they aren't I'd like to forward to that recipient.
Alternatively I'd like to add a recipient and then send only to the added recipient.

Sub ForwardCalendarItems()

'This code will iterate through all the appointments the calendar for the next three months. For each appointment, it checks if the invitee’s email is in the list of recipients. If not, it forwards the appointment to the invitee. 

    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olAppt As Outlook.AppointmentItem
    Dim olRecipients As Outlook.Recipients
    Dim olRecipient As Outlook.Recipient
    Dim DateStart As Date
    Dim DateEnd As Date
    Dim InviteeEmail As String
    Dim Found As Boolean

    InviteeEmail = "" ' Initial setting to ensure is clear

    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(olFolderCalendar)
    Set olItems = olFolder.Items

    DateStart = Date
    DateEnd = DateAdd("m", 3, DateStart)
    olItems.Sort "[Start]"
    olItems.IncludeRecurrences = True

    Set olAppt = olItems.Find("[Start] >= """ & DateStart & """ and [Start] <= """ & DateEnd & """")


'Spirit Email

    InviteeEmail = "[email protected]" 'SE eMail TC

    While TypeName(olAppt) <> "Nothing"
        Found = False
        Set olRecipients = olAppt.Recipients
        For Each olRecipient In olRecipients
            If olRecipient.Address = InviteeEmail Then
                Found = True
                Exit For
            End If
        Next
        If Not Found Then
            olAppt.ForwardAsVcal.Recipients.Add InviteeEmail
            olAppt.ForwardAsVcal.Send
        End If
        Set olAppt = olItems.FindNext
    Wend

    Set olAppt = Nothing
    Set olItems = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing

End Sub