Dim StartDatum As String
Dim Dauer As Long
Dim Beschreibung As String
Dim Nachricht As String
Dim Ort As String
With Excel.Selection
StartDatum = .Cells(Start).Value
Dauer = .Cells(Duration).Value
Beschreibung = .Cells(Label).Value
Nachricht = .Cells(msg).Value
Ort = .Cells(place).Value
End With
lvOutlook StartDatum, Dauer, Beschreibung, Nachricht, Ort
End Sub
Public Function lvOutlook(outDate As String, outDauer As Long, outSubject As String, outBody As String, outlocation As String) As Boolean
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
.Start = Format(outDate, "dd.mm.yyyy") & " 08:00"
.Subject = outSubject
.Location = outlocation
.Duration = outDauer
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With
Set apptOutApp = Nothing
Set OutApp = Nothing
lvOutlook = True
MsgBox "Termin an Outlook übertragen."
Exit Function
ErrOutLook:
Set apptOutApp = Nothing
Set OutApp = Nothing
lvOutlook = False
MsgBox "Termin konnte in Outlook nicht eingetragen werden. Fehler:" & Err.Description
End Function