Termingenerierung Problem mit .Recipients.Add

Public Sub terminegenerieren()
Dim TerminText As String
Dim OutApp As Object, apptOutApp As Object
Dim Spalte, SpalteN As Variant
Dim objRecipient As Outlook.Recipient
Dim b, x As Integer
Range("B2").Select
'Do Until ActiveCell.Value = "Stop"
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
Set objRecipient = Nothing
With apptOutApp
.BusyStatus = 0
.Start = Format(ActiveCell.Value, "dd.mm.yyyy") & " 08:00"
.Subject = ActiveCell.Offset(0, 1)
.Recipients.Add "test@testing.de"
.Body = "Hier steht ein Text."
.Location = "Büro"
.Duration = "60"
.ReminderMinutesBeforeStart = 10
.ReminderSet = True
.ResponseRequested = True
.Send
.Save
ActiveCell.Offset(0, 4) = .EntryID
End With
ActiveCell.Offset(1, 0).Select
Set apptOutApp = Nothing
Set OutApp = Nothing
'Loop
MsgBox "Termin an Outlook übertragen!"
End Sub