Termine per Befehl zu Outlook
25.05.2018 09:48:12
Juergen
mich hat das Outlook-Thema wieder eingeholt :/
Ich hatte zwar bereits eine Lösung, welche auch bei einem anderen Sheet super funktioniert, doch ich müsste das für eine neue Struktur anpassen.
Ich habe nun eine Tabelle, in dem im Prinzip dasselbe erledigt werden soll, aber eben ein bisschen anders. Habe schon rum-gedoktert, aber doch wieder auf den Boden der Selbsterkenntnis gekommen: bin zu blöd.
Hier mein Beispiel:
https://www.herber.de/bbs/user/121815.xlsm
Frage:
ich möchte die Einträge aus Spalte A bis E per Zeile zu Outlook als einen Ganztags-Termin mit den Daten generieren.
Mein bereits bestehendes Script schaut wie folgt aus. Könnte man das in angepasster Form dazu hernehmen?
Sub erstelleOutlookTermin(Target As Range)
If Target.Value "" Then
If MsgBox("Neuen Termin für " & Tabelle1.Cells(Target.Row, "C") & " (" & Tabelle1.Cells( _
Target.Row, "B") & ") erstellen?", vbOKCancel, "Outlook Termin") = vbOK Then
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
'Kategorie
.Categories = "TÜV Termin"
'Start- & Enddatum
.Start = DateSerial(Year(Tabelle1.Cells(Target.Row, "E")), Month(Tabelle1.Cells( _
Target.Row, "E")) + Tabelle1.Cells(Target.Row, "D"), 1)
.End = DateSerial(Year(Tabelle1.Cells(Target.Row, "E")), Month(Tabelle1.Cells( _
Target.Row, "E")) + Tabelle1.Cells(Target.Row, "D"), 31)
'Zusätzlicher Text
.Body = "Letzter TÜV: " & Tabelle1.Cells(Target.Row, "E")
'Betreff
.Subject = Tabelle1.Cells(Target.Row, "C") & " (" & Tabelle1.Cells(Target.Row, " _
B") & ") | TÜV"
'Ganztägiges Ereignis
.AllDayEvent = True
'Termin speichern
.Save
'Anzeigen
'.Display
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
Tabelle1.Cells(Target.Row, "J").AddComment Text:="Termin in Outlook eingetragen _
am " & Now
'Kommentar einfügen
End With
End If
End If
End Sub
Hätte jemand eine Idee zur Umsetzung?
Danke & Gruss,
Juergen