Termin von Excel nach Outlook als Serientermin?

Sub Outlooktermine_eintragen()
Dim OLApp           As Outlook.Application
Dim apptOutlook     As Outlook.AppointmentItem
Dim lastrow         As Integer
Dim OLCalName       As Object
Dim myPersCal       As Object
Dim i               As Integer
Dim Suchkriterium   As String
Dim intRow          As Integer
Set OLApp = CreateObject("Outlook.Application")
Set OLCalName = OLApp.GetNamespace("MAPI")
Set myPersCal = OLCalName.GetDefaultFolder(olFolderCalendar)
lastrow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
For intRow = 3 To lastrow
If Cells(intRow, 5)  "" Then
'Durchsuchen, ob es den Termin bereits gibt.
'Wenn ja, löschen
Suchkriterium = Cells(intRow, 2)
For i = myPersCal.Items.Count To 1 Step -1
If myPersCal.Items(i).Subject = Suchkriterium Then
myPersCal.Items(i).Delete
End If
Next
'Neuen Termin eintragen
Set apptOutlook = OLApp.CreateItem(olAppointmentItem)
With apptOutlook
.Subject = Suchkriterium
.Body = Cells(intRow, 3).Value
.Location = Cells(intRow, 4).Value
.Start = Cells(intRow, 5)
.Duration = Cells(intRow, 6).Value
.ReminderMinutesBeforeStart = 10
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With
End If
Next
Set OLApp = Nothing
Set OLCalName = Nothing
Set myPersCal = Nothing
Set apptOutlook = Nothing
End Sub