Mit Excel einen Termin in Outlook erzeugen + löschen alter Einträge

Sub createAppointments()
    On Error Resume Next
    Dim sheet As Worksheet, rngStart As Range, rngEnd As Range, cell As Range
    Set objOL = CreateObject("Outlook.Application")  
    Set objCal = objOL.Session.GetDefaultFolder(9)
    Set sheet = Worksheets(1)
    Set rngStart = sheet.Range("A2")  
    Set rngEnd = rngStart.End(xlDown)
    counter = 0
    For Each cell In sheet.Range(rngStart, rngEnd)
        strSubject = cell.Text
        strStartDate = cell.Offset(0, 1).Text
        strStartTime = cell.Offset(0, 2).Text
        strEndDate = cell.Offset(0, 3).Text
        strEndTime = cell.Offset(0, 4).Text
        boolAllDay = cell.Offset(0, 5).Value
        strCategory = cell.Offset(0, 6).Text
        strComment = cell.Offset(0, 7).Text
        
        'Eventuelles Duplikat des Termins finden ---------  
        Dim dupe_item As Object, itm As Object
        If boolAllDay Then
            Set dupe_item = objCal.items.Restrict("[Start] = """ & Format(strStartDate, "ddddd") & " 12:00 AM"" AND [END] = """ & Format(DateAdd("d", 1, DateValue(strEndDate)), "ddddd") & " 12:00 AM"" AND [Subject] = '" & strSubject & "'")  
        Else
            Set dupe_item = objCal.items.Restrict("[Start] = """ & Format(strStartDate & " " & strStartTime, "ddddd hh:nn") & """ AND [END] = """ & Format(strEndDate & " " & strEndTime, "ddddd hh:nn") & """ AND [Subject] = '" & strSubject & "'")  
        End If
        Set itm = dupe_item.GetFirst
        Set olApp = IIf(itm Is Nothing, objCal.items.Add(1), itm)
        '--------------------------  
        
        With olApp
            
            .Subject = strSubject
            .ReminderSet = False
            If strCategory <> "" Then  
                .Categories = strCategory
            End If
            .Body = strComment
            If boolAllDay = True Then
                .AllDayEvent = True
                If IsDate(strStartDate) Then
                    .Start = DateValue(strStartDate)
                    .End = DateAdd("d", 1, DateValue(strStartDate))  
                    .Save
                    counter = counter + 1
                Else
                    MsgBox "Termin mit dem Betreff: '" & strSubject & "' in Zeile " & cell.Row & " hat ungültige oder fehlende Zeitangaben", vbExclamation  
                End If
            Else
                .AllDayEvent = False
                If IsDate(strStartDate) And IsDate(strEndDate) And IsDate(strStartTime) And IsDate(strEndTime) Then
                    .Start = DateValue(strStartDate) & " " & TimeValue(strStartTime)  
                    .End = DateValue(strEndDate) & " " & TimeValue(strEndTime)  
                    .Save
                    counter = counter + 1
                Else
                    MsgBox "Termin mit dem Betreff: '" & strSubject & "' in Zeile " & cell.Row & " hat ungültige oder fehlende Zeitangaben", vbExclamation  
                End If
            End If
        End With
    Next
    Set objOL = Nothing
    MsgBox counter & " Termin(e) wurden erstellt!", vbInformation  
End Sub