Outlook Kalender Serientermin mit Ausnahmen

Sub JedeVierteInstanzLoeschen()
    Dim itm As Object, itms As items, subject As String, cnt as Integer
    subject = "Meine TerminSerie"  
    Set itms = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).items  
    itms.Sort "[Start]"  
    itms.IncludeRecurrences = True
    Set itms = itms.Restrict("[SUBJECT] = """ & subject & """ AND [IsRecurring] = True")  
    cnt = 1
    Set itm = itms.GetFirst
    While Not itm Is Nothing
        If cnt Mod 4 = 0 Then
            itm.Delete
        End If
        Set itm = itms.GetNext
        cnt = cnt + 1
    Wend
End Sub

Sub ErstelleTerminJedenFreitagAusserjeden4ten()
    Dim app As AppointmentItem
    Set app = Application.CreateItem(olAppointmentItem)
    dtStart = CDate("31.03.2023 08:00")  
    dtEnd = CDate("31.03.2023 08:30")  
    dtSeriesEnd = CDate("02.06.2023")  
    With app
        .Start = dtStart
        .End = dtEnd
        .subject = "Mein Termin"  
        With .GetRecurrencePattern
            .DayOfWeekMask = olFriday
            .Interval = 1
            .EndTime = dtSeriesEnd
        End With
        .Save
        dt = DateAdd("ww", 3, dtStart)  
        cnt = 1
        While dt <= dtSeriesEnd
            .GetRecurrencePattern.GetOccurrence(dt).Delete
            dt = DateAdd("ww", 4, dt)  
        Wend
    End With
End Sub