Update or Delete Multiple Appointments in Outlook (1 Viewer)

[Integrate]

I have a code that adds 11 appointments to outlook for each stage of a job. As each stage is complete the client clicks on the tick box next to the stage date and the After Update procedure deletes the appointment in outlook and replaces it with basically the same appointment but with "Complete" at the start of the subject.

The client now wants to be able to tick a number of stages at a time then click a refresh button so it updates multiple appointments in outlook. Is it possible to edit an outlook appointment without having to delete and re-enter with the new subject, or is it possible to loop the delete and replace code?

I attached a screen print of the form being used. All dates are added to outlook by clicking the button at the top of the form next to the Added to Outlook tick box.

This is the code that runs once a tick is placed in one of the boxes:

Private Sub Made_AfterUpdate()
 Dim objOutlook As Outlook.Application
 Dim objNamespace As Outlook.NameSpace
 Dim objFolder As Outlook.MAPIFolder
 Dim objAppointment As Outlook.AppointmentItem
 Dim lngDeletedAppointements As Long
 Dim strSubject As String
 Dim dteStartDate As Date
 Dim CurrentForm As String
 Dim olfolder As Object

 '* Set Criteria for DELETION here ********************************
 dteStartDate = Me.Controls("DateTemplateMade") & " " & Me.Controls("sttm")
 '*********************************************************
 Set objOutlook = Outlook.Application
 Set objNamespace = objOutlook.GetNamespace("MAPI")
 Set objFolder = objNamespace.GetDefaultFolder(olFolderCalendar)
 Set olfolder = objOutlook.GetNamespace("MAPI").PickFolder

 For Each objAppointment In olfolder.Items
   If objAppointment.Mileage = Me.QuoteNo And objAppointment.Start = dteStartDate Then
        objAppointment.Delete
          lngDeletedAppointements = lngDeletedAppointements + 1
   End If
 Next
 Set objAppointment = olfolder.Items.Add
 
 Start = dteStartDate
 With objAppointment
    .Start = Nz(Me.DateTemplateMade, "") & " " & Nz(sttm, "")
    .End = Nz(Me.DateTemplateMade, "") & " " & Nz(ettm, "")
    .Subject = "Complete" & " " & Nz(Me.templatemade & " " & Me.JobName, vbNullString)
    .Mileage = Nz(Me.QuoteNo, vbNullString)
    .Location = Nz(Me.InstallAddress & ", " & Me.InstallAddress2 & ", " & Me.Town_City)
    .Body = Nz(Me.Notes, vbNullString)
    .Categories = Nz(Me.templatemade, vbNullString)
           .Save
    End With 
      Me.Dirty = False
    ' Inform the user
    MsgBox "Appointment Updated!", vbInformation

Code for adding appointment with "Complete" in the subject if tick box is ticked - hoping I can either use this to update existing appointment or delete and replace:

Private Sub cmdComplete_Click()
        Me.Dirty = False
 
If Me.chkAddedtoOutlook = True Then
    MsgBox "This appointment has already been added to Microsoft Outlook", vbCritical
    ' Exit the procedure
    Exit Sub
Else
    ' Add a new appointment.
' Use late binding to avoid the "Reference" issue
Dim olapp As Object ' Outlook.Application
Dim olappt As Object ' olAppointmentItem
Dim i As Integer
Dim ctl As Control
Dim cat As Control
Dim olfolder As Outlook.MAPIFolder
Dim stg As Control
Dim st As Control
Dim et As Control
Dim comp As Control


If isAppThere("Outlook.Application") = False Then
    ' Outlook is not open, create a new instance
    Set olapp = CreateObject("Outlook.Application")
Else
    ' Outlook is already open--use this method
    Set olapp = GetObject(, "Outlook.Application")
End If
Set olfolder = olapp.GetNamespace("Mapi").Folders("Mailbox - melinda@integratedatasolutions.co.nz")
     For i = 1 To 11
   
    Set olappt = olfolder.Items.Add ' olAppointmentItem
    Set ctl = Me.Controls(Choose(i, "DateTemplateMade", "DateofTopCut", "DateBowlCut", "dateassembletop", _
    "DateGlueTop", "DatePolishTop", "dateinstallpackers", "dategluesink", "datepaint", "datequalitycheck", _
    "deliveryinstalled"))
    Set cat = Me.Controls(Choose(i, "Templatemade", "TopCut", "BowlCut", "AssembleTop", "GlueTop", _
    "PolishTop", "InstallPackers", "Gluesink", "Paint", "Qualitycheck", "DeliveryInstall"))
    Set stg = Me.Controls(Choose(i, "Templatemade", "TopCut", "BowlCut", "AssembleTop", "GlueTop", _
    "PolishTop", "InstallPackers", "Gluesink", "Paint", "Qualitycheck", "DeliveryInstall"))
      Set st = Me.Controls(Choose(i, "sttm", "sttc", "stbc", "stat", "stgt", "stpt", "stip", "stgs", "stp", _
    "stqc", "stdi"))
    Set et = Me.Controls(Choose(i, "ettm", "ettc", "etbc", "etat", "etgt", "etpt", "etip", "etgs", "etp", _
    "etqc", "etdi"))
    Set comp = Me.Controls(Choose(i, "tMade", "tTopCut", "tBowlCut", "tAssembled", "tGluedTop", "tPolished", _
    "tInstalled", "tGluedSink", "tPainted", "tchecked", "tDelivered"))
    Rem check value of current control
      If Not Nz(ctl, "") = "" And Nz(comp, "") = True Then
              Rem control is neither Null nor empty string - create appointment
    Start = ctl
    With olappt
    ' If There is no Start Date or Time on
    ' the Form use Nz to avoid an error
    ' Set the Start Property Value
    .Start = Nz(ctl, "") & " " & Nz(st, "")
    ' Set the End Property Value
    .End = Nz(ctl, "") & " " & Nz(et, "")
    .Subject = Nz("Complete" & stg & " " & Me.JobName, vbNullString)
    .Mileage = Nz(Me.QuoteNo, vbNullString)
    .Location = Nz(Me.InstallAddress & ", " & Me.InstallAddress2 & ", " & Me.Town_City)
    .Body = Nz(Me.Notes, vbNullString)
    .Categories = cat
    .ReminderSet = False
    
         .Save
    End With
    End If
    Next
   
    End If ' Release the Outlook object variables.
    Set olappt = Nothing
    Set olapp = Nothing    ' Set chkAddedToOutlook to checked
    Me.chkAddedtoOutlook = True
      Me.Dirty = False
   
    ' Inform the user
    MsgBox "Appointment Added!", vbInformation
End Sub

This is all pieced together from searching the internet so sorry if it is a bit messy.