Termine nach Outlook senden aber ohne Duplikate

Sub Termine_nach_Outlook()
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("G4")
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 = "Grüne Kategorie"
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
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
End If
End If
End With
Next
Set objOL = Nothing
MsgBox counter & " Einträge erstellt", vbInformation 
End Sub