Übertrag von Terminen nach Outlook
14.09.2020 08:54:08
Terminen
mit dem folgenden Code übertrage ich Termine von Excel nach Outlook. Soweit funktioniert auch alles gut bis auf die Erinnerungsfunktion. Es handelt sich um ein ganztägiges Ereignis, welches übertragen wird. Outlook setzt hier die Erinnerungszeit standardmäßig auf 18 Stunden vorher. Ich schaffe es nicht, die Erinnerungszeit bspw. auf 2 Stunden vorher zu ändern.
Mit dem Befehl .ReminderMinutesBeforeStart = 120 sollte dies doch eigentlich funktionieren, oder übersehe ich hier etwas?
Das ganz habe ich mit Excel 365 (neuste Version) erstellt.
Hier der Code
Sub Geburtstagstermine_nach_Outlook()
'** Übertragen der Geburtstagstermine von Excel nach Outlook
'** Dimensionierung der Variablen
Dim olApp As Object
Dim olNS As Object
Dim olAI As Object
Dim olFolder As Object
Dim iRow As Integer
Dim lngZ As Long
Dim lngCounter As Long
Dim lngStartJahr As Long
'** Vorgaben definieren
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olFolder = olNS.GetDefaultFolder(9)
Set wsgeb = ThisWorkbook.Sheets("Geburtstag")
lngCounter = 0
'** Startjahr in Variable zwischenspeichern
lngStartJahr = wsgeb.Range("G5").Value
'** Startjahr in Zelle B9 übertragen
wsgeb.Range("B9").Value = lngStartJahr
'** Termine eintragen
'** Serientermine eintragen - Anzahl aus Zelle G4
For b = 1 To wsgeb.Range("G4").Value
'** Durchlaufen aller Zeilen
For a = 11 To 12 'wsgeb.Cells(Rows.Count, 5).End(xlUp).Row
'** Termine nacheinander eintragen
'** Neuen Outlook-Termin erzeugen
Set olAI = olApp.CreateItem(1)
'** In Kalender eintragen
With olAI
'** Ganztägiger Termin
.AllDayEvent = True
.Start = Format(wsgeb.Cells(a, 2).Value, "dd.mm.yyyy") 'Beginnt am (Spalte B)
.ReminderMinutesBeforeStart = 120 'Erinnerung vorher in Minuten
.ReminderSet = True
.Subject = "Geburtstag: " & wsgeb.Cells(a, 5).Value
.Location = wsgeb.Cells(a, 11).Value 'Ort
.Body = wsgeb.Cells(a, 10).Value 'Beschreibung
'** In Kalender speichern
'.Save
.display
End With
Next a
'** Serien-Jahr um 1 erhöhen
wsgeb.Range("B9").Value = wsgeb.Range("B9").Value + 1
'** Berechnen, damit die Formeln in Spalte B aktualisiert werden und das neue Datum zum
'** Eintragen ermittelt wird
Application.Calculate
Next b
'** Variablen zurücksetzen
Set olAI = Nothing
Set olNS = Nothing
Set olApp = Nothing
'** Hinweis ausgeben
MsgBox "Die Geburtstags-Termine wurden in den Kalender eingetragen.", vbInformation, "Hinweis"
'** Statusleiste zurücksetzen
'Application.StatusBar = False
End Sub
Vielen lieben Dank für euere Mühe schon mal im Voraus.
LG Armin