Terme aus Excel nach outlook

Private Sub CommandButton1_Click()
Dim OutApp As Object, apptOutApp As Object
Dim i As Integer, myC As Integer
Dim Mldg, Stil, Titel, Antwort
myC = 9
Rows("1:1").Select
Selection.AutoFilter
Range("A2").Select
Range("A65536").End(xlUp).Offset(1, 8).Select
ActiveCell.Value = (Date)
For i = 1 To Cells(65536, myC).End(xlUp).Row
If Cells(i, myC) = "" Then
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
.Subject = Cells(i, 7) & " " & "SM-Auftrag" & " " & Cells(i, 3)
.Body = "Bereitstellung vom Bvh" & " " & Cells(i, 3)
.Location = Cells(i, 7)
.AllDayEvent = False
.Start = Format(Cells(i, myC - 1))
.End = Format(Cells(i, myC + 1))   ?
.Duration = 5
.ReminderMinutesBeforeStart = 30
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With
Set apptOutApp = Nothing
Set OutApp = Nothing
End If
Beep    ' Signalton ausgeben
Next i
Rows("1:1").Select
Selection.AutoFilter Field:=8, Criteria1:=""
Range("A65536").End(xlUp).Offset(1, 8).Select
ActiveCell.Value = ""
Range("A65536").End(xlUp).Offset(0, 0).Select
Selection.AutoFilter
Mldg = "       Alle BZA-Termine              " & Chr(10) & _
"       offener Bvh                   " & Chr(10) & _
"       an Outlook gesendet           " & Chr(10) & _
"                                     " & Chr(10) & _
Stil = vbOKOnly
Titel = "Auftragsverwaltung"
Kontext = 1000
Antwort = MsgBox(Mldg, Stil, Titel)
End Sub