Termine aus Excel in Outlook importieren (VBA)

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.Stores.Item("test@test.de").GetDefaultFolder(9).Folders.Item("Excel Test")  
    Set sheet = Worksheets("Termine")  
    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
            strLocation = cell.Offset(0, 6).Text
            strComment = cell.Offset(0, 7).Text
            boolReminderSet = cell.Offset(0, 8).Value = True
            
            'Eventuelles Duplikat des Termins finden ---------  
            Set allItems = objCal.items
            allItems.Sort "[Start]"  
            ' Ganztagestermin oder normaler Termin unterscheiden  
            If boolAllDay = True Then
                ' Filtere Termine nach Ganztagesevents zu dieser Zeit und dem Betreff  
                Set dupe_item = allItems.Restrict("[Start]=""" & Format(strStartDate, "dd.mm.yyyy hh:mm") & """ AND [END]= """ & Format(DateAdd("d", 1, DateValue(strEndDate)), "dd.mm.yyyy hh:mm") & """ AND [Subject] = '" & strSubject & "' AND [AllDayEvent] = True")  
            Else
                ' Filtere normale Termine zu dieser Zeit und dem Betreff  
                Set dupe_item = allItems.Restrict("[Start]=""" & Format(strStartDate, "dd.mm.yyyy" & strStartTime, "hh:mm") & """ AND [END]= """ & Format(strEndDate, "dd.mm.yyyy" & strEndTime, "hh:mm") & """ AND [Subject] = '" & strSubject & "' AND [AllDayEvent] = False")  
            End If
            ' hole den ersten passenden Termin wenn er exisitiert  
            Set itm = dupe_item.GetFirst
    
            If itm Is Nothing Then
                ' erstelle neuen Termin wenn kein Duplikat exisitert  
                Set olApp = objCal.items.Add(1)
            Else
                ' verwende den gefundenen Termin  
                Set olApp = itm
            End If
        
            With olApp
                .Location = strLocation
                .ReminderSet = boolReminderSet
                .Subject = strSubject
                .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
            Set olApp = Nothing
        Next
        Set objOL = Nothing
        MsgBox counter & " Termin(e) wurde(n) erstellt!", vbInformation  
    End Sub