Duplikate beim Terminexport nach Outlook

Sub Excel_Control_Termin_nach_Outlook()
Dim OutApp As Object, apptOutApp As Object
'Mit Range("T3").Select beginnen die Termine mit dem 1. Feld oben, sonst in der aktiven Zelle.
Range("T3").Select
Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
With apptOutApp
'Datum und Uhrzeit 08:00 Uhr
.Start = Format(ActiveCell.Value, "dd.mm.yyyy") & " 08:00"
'Dauer. Angabe ist jeweils in ganzen Minuten zu setzen
'Termininfo
'der Betreff steht in der Spalte rechts von den Terminen
.Subject = Range("A" & ActiveCell.Row)
'Betreff-Text
.Body = "Wiedervorlage"
'Ort
.Location = Range("D" & ActiveCell.Row)
'Dauer des Termins in Minuten
.Duration = "0"
'Erinnerung
.ReminderMinutesBeforeStart = 10
'mit Sound :-)
.ReminderPlaySound = True
'Erinnerung wiederholen
.ReminderSet = True
'Termin speichern
.Save
End With
'Nächste Zelle auswählen
ActiveCell.Offset(1, 0).Select
'Variablen leeren,... sonst kotzt Outlook irgendwann mal!
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
MsgBox "Termine wurden nach Outlook übertragen!"
End Sub