Append Outlook Appointment through Access VBA

Question

I'm trying to figure out if it's possible to change (append/truncate) an outlook appointment. Example I have a table a date column and if the date for that record is a future date I want it to create an appointment in outlook if one isn't already there. If an appointment already exists I want it to add a line to the body of the appointment.

Here is an example of the code I'm currently using. It will create the appointment if one doesn't already exist but I'm not sure what the procedure is to append an existing appointment where the subject lines match.

Is what I'm trying to do possible? Any help would be greatly appreciated!

Private Sub Process_InSeason_Click()
Dim olobj As Outlook.Application
Dim oloappt As Outlook.AppointmentItem
Dim myOptionalAttendee As Outlook.Recipient
Dim PackNum As String
Dim Desc As String
Dim Brand As String
Dim rs As Dao.Recordset
Dim objAppointment As Outlook.AppointmentItem

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set objOutlook = Outlook.Application
Set rs = CurrentDb.OpenRecordset("qryEventSetup")
Set olobj = CreateObject("Outlook.Application")
Set oloappt = olobj.CreateItem(olAppointmentItem)
Set myOptionalAttendee = oloappt.Recipients.Add("[email protected]")

myOptionalAttendee.Type = olOptional

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Save records and turn on Error Control
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DoCmd.RunCommand acCmdSaveRecord
On Error GoTo Add_Err

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Validate if Markdown End date is future date
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
rs.MoveFirst
If Not (rs.EOF And rs.BOF) Then
Do Until rs.EOF = True

Appt = rs.Fields("Markdown End Date").Value
Appt = DateSerial(Year(Appt), Month(Appt), Day(Appt))
Appt = Appt + TimeSerial(8, 0, 0)

PackNum = rs.Fields("Pack_Number")
Desc = rs.Fields("Description")
Brand = rs.Fields("Brand Offer")

'Deleteappt

    With oloappt
            '.RequiredAttendees = myOptionalAttendee
            .Subject = "Remove Markdowns for all Offers"
            .Body = "" & PackNum & "  " & Desc & "  " & Brand & " Please update page number to 851 for all markdown 6 prefixes"
            .MeetingStatus = 1
            .ResponseRequested = True
            .Start = Appt
            .Duration = 10
            .ReminderSet = True
            .ReminderMinutesBeforeStart = 1440
            .Save
            '.Display
            .Send
            .Close (olSave)
    End With
rs.MoveNext
Loop
    MsgBox "Markdown End Date(s) have been added to your Calendar"
End If
'DoCmd.RunCommand acCmdSaveRecord

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'End process and clean up
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set oloappt = Nothing
Set olobj = Nothing
Set rs = Nothing
Set myOptionalAttendee = Nothing

Exit Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Error validation
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Add_Err:
MsgBox "oops error found " & Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub