Excel Termine an Outlook

Question

Hallo,

ich habe ein Problem bei dem ich nicht weiter kommen und wollte mal fragen ob hier jemand Rat weiß. Ich habe ein Excel Makro, das eine Spalte mit Daten durchläuft und immer wenn ein Termin kurz bevor steht benachrichtigt es mich bei Outlook. Es sind feststehende Termine (quasi wie Geburtstage). Das Ganze funktioniert ganz gut, nur dass ich auch eine Nachricht für Daten bekomme die schon in der Vergangenheit liegen. Zwecks dessen wollte ich eine if Abfrage einbauen, die zum einen die Benachrichtigung stoppt und zum anderen das Datum um ein Jahr aktualisiert.

Beispiel: 29.09.2009 --> 29.09.2010

Hier mal der Code, bin leider nicht so findig in VBA

Sub Termine_to_Outlook()
Dim d As Date
Dim LDate As Date
Dim OutApp As Object, apptOutApp As Object

Range("F4").Select
Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
With apptOutApp
.Start = Format(ActiveCell.Value - 7, "dd.mm.yyyy") & " 08:00"

If Format(Now(), "dd.mm.yyyy") > Format(ActiveCell.Value, "dd.mm.yyyy") Then
ReminderSet = False
LDate = DateAdd("yyyy", 1, Now())
ActiveCell.Value = LDate
End If

.Subject = "" & ActiveWorkbook.Name & ""
.Subject = ActiveCell.Offset(0, 1)
.Body = "Redaktionsschluss"
.Location = ""
.Duration = "2"
.ReminderMinutesBeforeStart = 10
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With

ActiveCell.Offset(1, 0).Select

Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
MsgBox "Termine an Outlook übertragen!"
End Sub


Gruss Uli

Answer 1

Hallo Uli,

meinst Du das wie mit nachfolgendem Makro realisiert?

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
[b]Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.[/b]

[b][code]Option Explicit

Sub Termine_to_Outlook()
Dim d As Date
Dim LDate As Date
Dim OutApp As Object
Dim apptOutApp As Object
Dim ReminderSet As Boolean

Range("F4").Select

Do Until ActiveCell.Value = ""
    Set OutApp = CreateObject("Outlook.Application")
    Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
    
    If CDate(ActiveCell.Value - 7) < Now Then
       ActiveCell.Value = DateSerial(Year(ActiveCell.Value) + 1, Month(ActiveCell.Value), Day(ActiveCell.Value))
    End If

    With apptOutApp
        .Start = Format(ActiveCell.Value - 7, "dd.mm.yyyy") & " 08:00"
        .Subject = "" & ActiveWorkbook.Name & ""
        .Subject = ActiveCell.Offset(0, 1)
        .Body = "Redaktionsschluss"
        .Location = ""
        .Duration = "2"
        .ReminderMinutesBeforeStart = 10
        .ReminderPlaySound = True
        .ReminderSet = True
        .Save
    End With
    ActiveCell.Offset(1, 0).Select
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
MsgBox "Termine an Outlook übertragen!"
End Sub[/code][/b]Hier werden Dir nur Termine der Gegenwart und Zukunft eingetragen. Wird beim Durchlaufen der Do/Loop-Schleife ein Datumswert gefunden, der in der Vergangenheit liegt, wird das Jahr um 1 Jahr erhöht und der Termin dann eingetragen.

Ich hoffe, Du meintest das so?

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 2

Hallo Oliver,

erstmal ganz ganz herzlichen Dank für den Code. Das kommt dem was ich haben möchte schon sehr nahe. Könntest Du mir noch
nen Tipp geben, wie ich erreiche, dass nur die Termine die auch wirklich am gleichen Tag fällig sind bei Outlook eingetragen werden?

Beispiel:

17.12.
heute: 7.10 14.10
28.09

Dann soll am 7.10 nur der 14.10 als fälliger Termin im Kalender
erscheinen, der 28.09 aber aktualisiert werden. (Das geht ja schon mit der if-Schleife)
Das muss bestimmt irgendwie

If CDate(ActiveCell.Value - 7) = Now Then
ReminderSet = True
Else ReminderSet = False

lauten. Sorry hab gerade 2 Stunden probiert, habs aber nicht geschafft. Oder geht das überhaupt nicht?

Besten Dank im Vorraus. Sehr freundlich von Dir

Gruss Uli

Answer 3

Hallo Uli,

sory, aber ich verstehe das was Du geschrieben hast nicht so richtig. Du schreibst:

Dann soll am 7.10 nur der 14.10 als fälliger Termin im Kalender
erscheinen, der 28.09 aber aktualisiert werden.

Das bedeutet es soll der 7.10.2009 und auch der 28.09.2009 eingetragen werden? Wie soll das mit der Uhrzeit gehen, wenn Du im Makro als Uhrzeit 8:00 Uhr mit übergibst?

Das musst Du mal etwas genauer erklären. Soll nun nur das Datum oder auch die Uhrzeit abgefragt werden? Wo steht die Uhrzeit? Wirklich statisch wie in dem Makro oder in einer Zelle? Wir hier kennen Deine Datei nicht, daher die genaue Beschreibung Deiner Datei oder eine Beispieldatei bei z.B. http://www.file-upload.net/ hochladen und den Link, den Du erhälst, uns hier mitteilen.

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 4

Hey, sorry wenn´s ein wenig ungenau war, also:

Wir gehen aml vom heutigen Tag aus (7.10.2009)

Ich habe eine Spalte in der mehere Daten stehen z.B.:

F

28.09.2009
15.10.2009
17.12.2009

Der Code von oben rechnet ja zu den vergangenen Terminen ein Jahr dazu. Also wird der 28.09.2009 zum 28.09.2010.
Du hast Recht eigentlich muss er nur die Daten vergleichen und die Uhrzeit selber nicht zurückgeben. Sonst könnte es ja passieren, dass er mir den heutigen Tag als Vergangenheit ausspukt.
Da muss man statt der "Now" Funktion glaub ich "Date" nehmen oder ? Also Datum reicht.

Für das Beispiel oben trägt der Code mir folgende Termine bei Outlook ein:

07.10.2010 (aber das ja nur wegen der Uhrzeitübergabe)
10.12.2009

Ich möchte nun erreichen, dass er mir nur die Termine aus der Spalte einträget, die -7 Tage das heutige Datum ergeben und die zukünftigen Daten (zu denen ja jetzt auch die aktualisierten Vergangenen gehören) erstmal ignoriert und sie nicht im Kalender einträgt.
Für das Beispiel sollte also nur eine Nachricht für den 07.10.2009 eingetragen werden, die besagt, dass in einer Woche der Termin (15.10.2009) erreicht ist.

Kurz: Vergangene Termine bei Outlook ignoriert und ein Jahr erhöht werden
Termine aus der Spalte die - 7 Tage = heutiges Datum sollen bei Outlook im Kalender erscheinen
Zukünftige Termine (zu denen die aktualisierten Vergangenen jetzt auch gehören) sollen ignoriert werden bis wieder gilt - 7 Tage = heutiges Datum

Ich hoffe, das war jetzt besser erklärt.
Vielen Dank und Gruß

Ulli

Answer 5

Hallo Ulli,

dann sollte der anchfolgende Code funktionieren. So hoffe ich jedenfalls, dass ich es richtig verstanden habe.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Termine_to_Outlook()
Dim d As Date
Dim LDate As Date
Dim OutApp As Object
Dim apptOutApp As Object
Dim ReminderSet As Boolean

Range("F4").Select

Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)

If ActiveCell.Value - 7 = Date Then
With apptOutApp
.Start = Format(ActiveCell.Value - 7, "dd.mm.yyyy") & " 08:00"
.Subject = "" & ActiveWorkbook.Name & ""
.Subject = ActiveCell.Offset(0, 1)
.Body = "Redaktionsschluss"
.Location = ""
.Duration = "2"
.ReminderMinutesBeforeStart = 10
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With
ElseIf ActiveCell.Value - 7 < Date Then
ActiveCell.Value = DateSerial(Year(ActiveCell.Value) + 1, Month(ActiveCell.Value), Day(ActiveCell.Value))
End If
ActiveCell.Offset(1, 0).Select
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
MsgBox "Termine an Outlook übertragen!"
End Sub

MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]