Outlook Termin über Excl
30.10.2018 10:55:29
alex_de_souza
ich möchte direkt über Excl Outlook Termine erstellen und habe auch schon einen passenden Code gefunden:
Option Explicit
' Prüfen ob Outlook vorhanden ist.
Public Function OutlookAvail() As String
' Beispiel - Outlook überhaupt installiert ? und welche Version
' Fehlerbehandlung aktivieren
On Error GoTo ErrHandler
Dim oOutlook As Object
Set oOutlook = CreateObject("Outlook.Application")
OutlookAvail = oOutlook.Version
Set oOutlook = Nothing
Exit Function
ErrHandler:
OutlookAvail = ""
End Function
Sub auswahlNachOutlook()
'
' Beispiel-Funktion - Markieren - und autoamtisch eintragen in Outlook
' 2016, www.stallwanger.net
'
Dim StartDatum As String
Dim Dauer As Long
Dim Beschreibung As String
Dim Nachricht As String
Dim Ort As String
Dim Teilnehmer As String
With Excel.Selection
StartDatum = Format(.Cells(1, 1).Value, "dd.mm.yyyy hh:nn")
Dauer = .Cells(1, 2).Value * 60
Beschreibung = .Cells(1, 3).Value
Nachricht = .Cells(1, 4).Value
Ort = .Cells(1, 5).Value
Teilnehmer = .Cells(1, 6).Value
End With
'Nach Outlook
lvOutlook StartDatum, Dauer, Beschreibung, Nachricht, Ort, Teilnehmer
End Sub
Public Function lvOutlook(outDate As String, outDauer As Long, outSubject As String, outBody As _
String, outlocation As String) As Boolean
Dim OutApp As Object, objCalendar As Object
'Hier beginnen die Termine
Set OutApp = CreateObject("Outlook.Application")
Set objCalendar = OutApp.CreateItem(1) 'olAppointmentItem)
With objCalendar
'Datum und Uhrzeit - als Start-Uhrzeit 8:00 -
.Start = outDate
'Termininfo
.Subject = outSubject
'oder der Betreff steht in der Spalte rechts von den Terminen
.Location = outlocation ' 'Ort
.RequiredAttendees = True
.Duration = outDauer ' 1 Std. = "60" Dauer in Minuten
'Erinnerung setzen in Outlook (hier inaktiv)
'Text
.Body = outBody
.ReminderPlaySound = True
'Erinnerung wiederholen
.ReminderSet = True
'Termin speichern
.Save
End With
Set objCalendar = Nothing
Set OutApp = Nothing
lvOutlook = True
MsgBox "Termin an Outlook übertragen."
Exit Function
ErrOutLook:
Set objCalendar = Nothing
Set OutApp = Nothing
lvOutlook = False
MsgBox "Termin konnte in Outlook nicht eingetragen werden. Fehler:" & Err.Description
End Function
Was mir hier fehlt ist eine weitere Zelle die ich markieren kann, wo die Teilnehmer eingetragen sind und diese dann in die Einladung übernommen werden. Ich habe versucht, den Code anzupassen. Bin auch schon drauf gekommen, dass mit dem .RequiredAttendees geht, jedoch funktioniert es nicht.
Kann mir jemand dabei helfen?