Excel vba: Kurze Terminserie in Outlook erstellen

[sharky51]

Hallo zusammen,

ich hoffe ihr könnt mir mal wieder helfen.
Bisher habe ich aus Excel meine Termine aus einer Tabelle heraus nach Outlook übertragen - das funktionierte auch super - dank Eurer Hilfe
Um bei begrenzten Termin-Abfolgen nicht immer alle einzelnen Termine in der Tabelle auflisten zu müssen würde ich das gerne mit "einem" Datensatz machen.

Die Tabelle könnte dann ev. so aufgebaut werden:

Tabelle5

	D	E	F	G	H	I	J	K	L
5	Subject	Start	Ende					Location	Color-ID
6	Betreff	Beginntam	Endet am	Terminraster	Serientermin	Beginn	Endetum
7	Betreff	01.05.2018	30.09.2018	wöchentlich/monatlich	ja / nein	18:00	120	Hier	Gelbe Kategorie

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 21.08 einschl. 64 Bit

Folgendes Makro habe im Netz für sich jährlich wiederholende Termine gefunden:
Könntet Ihr mir einen Tipp geben wie das zu ändern wäre um zeitlich begrenzte Serien-Termine, also von Datum-Start bis Datum-Stopp im wöchentlichen oder monatlichem Raster in Outlook abgebildet werden könnte.

Code:

Option Explicit
Sub Einfügen()
    'adds a list of appontments to the Calendar in Outlook
   Dim OLApp As Outlook.Application
   Dim olAppItem As Outlook.AppointmentItem
   Dim OutApp As Object, apptOutApp As Object, oApp As Object, oAddr As Object, opattern As Object
   Dim OutPattern As RecurrencePattern
   Dim datStart As Date
   
   Dim endRow As Long
   Dim wsSenden As Worksheet
   Dim row As Long
   Const startRow As Long = 6
   
   Dim Zeile As Long, Zeile1 As Long, Suchbegriff As Long
   Zeile = Range("A65536").End(xlUp).row
   
   Set oApp = CreateObject("outlook.application")
   Set oAddr = oApp.CreateItem(olAppointmentItem)
   Set wsSenden = ThisWorkbook.Worksheets("Serientermine")
   
   endRow = Zeile
   On Error Resume Next
   Set OLApp = GetObject("", "Outlook.Application")
   On Error GoTo 0
   If OLApp Is Nothing Then
       On Error Resume Next
       Set OLApp = GetObject("Outlook.Application")
       On Error GoTo 0
       If OLApp Is Nothing Then
           MsgBox "Outlook is not available!"
           Exit Sub
       End If
   End If
   
   For row = startRow To endRow
       Set OutApp = CreateObject("Outlook.Application")
       Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
       With apptOutApp
           
           ' set default appointment values
           .MeetingStatus = olMeeting
           
           .AllDayEvent = True
           '.End = Now
           .Subject = "No subject"
           .Location = " "
           .Body = ""
           .ReminderSet = True
           ' read appointment values from the worksheet
           On Error Resume Next
           .Start = Cells(row, 3).Value '+ Cells(row, 5).Value
           '.End = Cells(row, 7).Value '+ Cells(row, 8).Value
           .Subject = Cells(row, 1).Value
           .Location = Cells(row, 13).Value
           .Body = Cells(row, 11).Value
           .Resources = Cells(2, 10).Value
           .ReminderMinutesBeforeStart = 720
           'mit Sound
           .ReminderPlaySound = True
           Set OutPattern = apptOutApp.GetRecurrencePattern
           OutPattern.RecurrenceType = olRecursYearly  ' wiederkehrender Termin
           .Duration = 1440
           On Error GoTo 0
           '.Save ' saves the new appointment to the default folder
           .Save
       End With
   Next
   
   Set olAppItem = Nothing
   Set OLApp = Nothing
   Set wsSenden = Nothing
   
   MsgBox "Termine wurden generiert"
End Sub

Vielen Dank für Eure Hilfe!

[sharky51]

Guten Morgen zusammen,
hat niemand eine Idee wie mein Problem lösbar wäre?

[Flotter Feger]

Hallo,
ich selbst verwende zwar kein Outlook ...

PHP-Code:

        .GetRecurrencePattern.RecurrenceType = olRecursYearly 'jährlich'
         .GetRecurrencePattern.PatternStartDate = "Hier das Startdatum angeben."
         .GetRecurrencePattern.Interval = 1 'einmalig'
         .GetRecurrencePattern.NoEndDate = True 'jedes Jahr' 


Unterhalb der Zeile

PHP-Code:

.ReminderPlaySound = True 


einfügen.

Könnte man(n) auch wunderbar googlen ... 'VBA Serientermin aus Excel in Outlook'

[sharky51]

Hallo Sabina,

vielen Dank für Deinen Vorschlag. Mit dem googeln ist das so eine Sache - man sieht den Wald vor lauter Bäumen nicht.
Aber Spaß beiseite.

Habe Deinen Vorschlag so umgesetzt wie beschrieben- aber leider werden die Serientermine zeitlich nicht begrenzt - selbst wenn ich Interval = 1 angebe läuft der Termin weiter.
Die Interval-Angabe wird irgendwie ignoriert!?

Hast Du ev. noch ne Idee an was das liegt? Mein Google-Finger ist schon wund  

[Flotter Feger]

Hallo,

... zeitlich begrenzt ? Keine Ahnung was du damit meinst !

Aber vielleicht wäre es sinnvoll, diese Frage in einem Outlook-Forum zu stellen ?

Die Helfer da, kennen sich in ihrem Element sicher besser aus, als eine junge Dame, die noch nicht mal Outlook verwendet.

[sharky51]

Hallo Sabina,

mit zeitlich begrenzt meine ich, dass ein Serientermin nicht bis ins Unendliche läuft.

Beispiel:
Ein Besprechungstermin soll ab einem Start-Datum bis zu einem definierten Enddatum stattfinden. Immer am gleichen Wochentag und immer zur gleichen Uhrzeit und mit der gleichen Zeitdauer.

Na ja ich bin halt in diesem Excel-Forum weil es a) super kompetent ist und b) ich halt aus Excel heraus die Termine steuern möchte.
Aber wenn ich nicht weiterkomme sollte ich Deinen Outlook-Vorschlag mal annehmen.

Aber vielleicht hat die junge Dame trotzdem noch eine Idee die einem älteren Herrn helfen könnte  

[Flotter Feger]

Hallo alter Mann,

... ich habe mal 2 Minuten lang für dich gegoogled ...

http://www.herber.de/forum/archiv/1492to...ellen.html
http://www.outlookcode.com/threads_print.aspx?forumid=2&messageid=28497 'Löschen des Ganzen ... falls nötig'
https://www.slipstick.com/office-365/imp...-calendar/


... und dann mal nachgedacht ...

PHP-Code:

        .GetRecurrencePattern.RecurrenceType = olRecursWeekly 'wöchentlich'
         .GetRecurrencePattern.PatternStartDate = "Hier das Startdatum angeben."
         .GetRecurrencePattern.Interval = 1 'einmalig'
         .GetRecurrencePattern.NoEndDate = False 'das endet auch mal'
         .GetRecurrencePattern.PatternEndDate = "Hier das Enddatum angeben." 


[sharky51]

Hallo Sabina,

vielen Dank für die Links - werde sie mal durcharbeiten.

Habe in der Zwischenzeit auch mal weiter geforscht - mit diesem Ergebnis für eine begrenzte Wiederholdauer von Wochen-Terminen.

Kleiner Code-Ausschnitt:

Code:

...........
   .Location = Cells(row, 2).Value
           .Start = Cells(row, 3).Value + Cells(row, 5).Value
           .End = Cells(row, 4).Value + Cells(row, 6).Value
           
           '.Resources = Cells(2, 10).Value
           .ReminderMinutesBeforeStart = 720
           'mit Sound
           .ReminderPlaySound = True
           
           'Farbkennzeichnung des Termins
           .Categories = Cells(row, 9).Value  'z.B. "Grüne Kategorie"
           
           'Raster für Wiederholungen
           Set OutPattern = apptOutApp.GetRecurrencePattern
           
           Trepeat = Cells(row, 8).Value
           Select Case Trepeat
               Case Is = "Jahr"
                   OutPattern.RecurrenceType = olRecursYearly      'wiederkehrender Termin
                   .Subject = "Geburtstag von:" & Cells(row, 12).Value & " (Wird " & Cells(row, 13).Value & " Jahre alt.)"
               Case Is = "Monat"
                   OutPattern.RecurrenceType = olRecursMonthly     'wiederkehrender Termin
               Case Is = "Woche"
                   OutPattern.RecurrenceType = olRecursWeekly      'wiederkehrender Termin
                   OutPattern.DayOfWeekMask = olTuesday            'Wochentag
                   OutPattern.Occurrences = 31                      'x Wiederholungen
                   '.GetRecurrencePattern.NoEndDate = True 'jedes Jahr'
               Case Else
                   MsgBox "Einige Termine wurden nicht angelegt!"
                   GoTo Weiter
           End Select
   ............

Eine Begrenzung der Laufzeit für Jahres-Termine habe ich leider noch nicht geschafft. Ich vermute das funktioniert nicht.

Vielen Dank für Deine Hilfe.

[Flotter Feger]

Hallo,

PHP-Code:

outPattern.Recurencetype = 5 'olRecurenceYearly'
.GetRecurrencePattern.NoEndDate = False
OutPattern.Occurences = 3 


Das erzeugt ein Ende der Serie nach 3 Jahren ... die Abfolge der Befehle ist wichtig !!!

[sharky51]

Hallo Sabina,

super herzlichen Dank!
Mit dieser Info funktioniert das Ganze jetzt perfekt.

Hast einem alten Mann sehr geholfen!

Vielen Dank und hab noch einen schönen Abend.