Terminübergabe an Outlook

Sub Excel_Control_Termin_nach_Outlook()
Dim OutApp As Object, apptOutApp As Object
'Mit Range("ZELLE").Select beginnen die Termine mit dem 1. Feld oben.
Range("N2").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"
'Termininfo (steht hier in der Spalte B)
.Subject = Range("B" & ActiveCell.Row)
'Betreff-Text
.Body = "Wiedervorlage"
'Ort (steht hier in Spalte D)
.Location = Range("D" & ActiveCell.Row)
'Dauer des Termins in Minuten
.Duration = "0"
'Erinnerung in Minuten vorher
.ReminderMinutesBeforeStart = 10
'mit Sound :-) (an: True / aus: False)
.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