Sub Excel_Control_Termin_nach_Outlook()
Dim OutApp As Object, apptOutApp As Object
Range("M2").end(xldown)(2,-1).Select
Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
.Start = Format(ActiveCell.Value, "dd.mm.yyyy hh:mm")
.Subject = "Rechnung: " & ActiveWorkbook.Name & " kontrollieren"
.Subject = ActiveCell.Offset(0, 1)
.Body = ""
.Location = "Büro"
.Duration = "60"
.ReminderMinutesBeforeStart = 15
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With
ActiveCell.Offset(1, 0).Select
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
MsgBox "Super - Termine an Outlook übertragen!"
End Sub