Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen

Übertrag von Terminen nach Outlook

Betrifft: Übertrag von Terminen nach Outlook von: Armin
Geschrieben am: 14.09.2020 08:54:08

Hallo zusammen,

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

Betrifft: AW: Übertrag von Terminen nach Outlook
von: Yal
Geschrieben am: 14.09.2020 17:58:15

Hallo Armin,

ich vermute, dass entweder nur die Anzeige nicht stimmt oder der Reminder beim Speichern richtig gesetzt wird.

Mit folgenden Code -eigentlich dein Code, nur mit festen Werte- funktioniert es
(mit Save, ohne Display):
Sub Geburtstagstermine_nach_Outlook()
Dim olApp As Object
Dim olNS As Object
Dim olAI As Object
Dim olFolder As Object

'** Vorgaben definieren
    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(9)
'** Termin herstellen
    Set olAI = olApp.CreateItem(1)
    With olAI
      .AllDayEvent = True
      .Start = DateSerial(2020, 9, 16)
      .ReminderMinutesBeforeStart = 120 'Erinnerung vorher in Minuten
      .ReminderSet = True
      .Subject = "Geburtstag: " & "Test"
      .Location = "Test-Ort"
      .Body = "Test-Body"
      .Save
    End With
'** Variablen zurücksetzen
    Set olAI = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub
noch eine Idee wäre zu speichern, dann reminder setzen und neuspeichern (zugegeben, nicht besonders schön)

LG Yal

Beiträge aus dem Excel-Forum zum Thema "Übertrag von Terminen nach Outlook"