Hallo, ich habe eine Tabelle die mit Ampelfunktion ausgestattet ist.
Es geht in der Tabelle um Schwertransportgenehmigungen die zeitlich begrenzt sind.
Ich möchte gerne per Email oder per Outlookkalender informiert werden wenn die Laufzeit z.B. gelb erreicht, sprich 60 oder 90 Tage.
Ist das möglich und wenn ja wie????
Ich habe die Tabelle mit angehängt und ich würde mich freuen wenn mir jemand helfen könnte.
eine Info per E-Mail aus Excel heraus hat zwei Voraussetzungen. Zum einen muss Excel gestartet sein und zum anderen muss einer vor dem Rechner sitzen und im Outlook "Senden" betätigen. Aus Sicherheitsgründen ist es schon seit langem nicht mehr möglich, aus Office heraus E-Mails direkt zu senden.
Um trotzdem E-Mails senden zu können muss man andere Wege beschreiten. Schaue Dir z.B. mal das an
Moin, also die Excel Datei schaffe ist bei mir auf dem Rechner, da aber dort an die 100 Termine drinnen sind möchte ich die Erinnerung direkt auf meinen Emailaccount bekommen.
Wenn das nicht möglich ist dann wenigstens in den Outlookkalender.
Es ist zeitaufwendig die ganzen Termine zu kontrollieren
hier mal ein Code. Der nimmt die Termine aus Spalte G, macht einen Termin draus mit einer Woche Erinnerung, und dann wird in Spalte U noch eine ID eingetragen. Was alles passiert ist kommentiert, kann man einiges ändern. Der Code kommt in ein normales Modul...
Code:
Option Explicit
Sub Excel_Control_Termin_nach_Outlook()
Dim wksSheet As Worksheet
Dim objFolder As Object
Dim objOutApp As Object
Dim objTermin As Object
Dim lngRow As Long
Dim LMinuten As Long
'On Error GoTo Fin
Set wksSheet = ThisWorkbook.Worksheets("Autokran") ' Anpassen!!!
Set objOutApp = CreateObject("Outlook.Application")
'9 = olFolderCalendar
Set objFolder = objOutApp.GetNamespace("MAPI").GetDefaultFolder(9)
'Schleife von Zeile 3 bis zur letzten gefuellten Zelle in Spalte A
For lngRow = 3 To Cells(Rows.Count, 1).End(xlUp).Row
'Wenn in Spalte 7 (G) ein Datum steht, dann
If IsDate(wksSheet.Cells(lngRow, 7).Value) Then
'Wenn Termin nicht schon vorhanden, dann
If Not fncPointExist(objFolder, wksSheet.Cells(lngRow, 2).Value) Then
Set objTermin = objOutApp.CreateItem(1)
'LMinuten = Format(wksSheet.Cells(lngRow, 4).Value, "h.mm")
With objTermin
'Starttermin (hier bswp.: Datum der Zelle um 14 Uhr)
.Start = Format(wksSheet.Cells(lngRow, 7).Value, "dd.mm.yyyy") & " 14:00"
'.Start = Format(wksSheet.Cells(lngRow, 7).Value, "dd.mm.yyyy") & " " & Format(wksSheet.Cells(lngRow, 3).Value, "hh:mm")
'Ende des Termins
'.End = Format(wksSheet.Cells(lngRow, 2).Value, "dd.mm.yyyy") & " 20:00"
'.End = Format(wksSheet.Cells(lngRow, 2).Value, "dd.mm.yyyy") '& " " & wksSheet.Cells(lngRow, 4).Value
'Daten aus Spalte A als Subjekt
.Subject = wksSheet.Cells(lngRow, 1).Value
'Inhalt des Termins
.Body = "Das macht Spass!"
'Ort
.Location = "DEKRA Gera"
'.Location = wksSheet.Cells(lngRow, 5).Value & " - " & wksSheet.Cells(lngRow, 6).Value
'Dauer in Minuten
.Duration = 15
'.Duration = wksSheet.Cells(lngRow, 4).Value
'Erinnerung vor Start in Minuten
.ReminderMinutesBeforeStart = 7 * 24 * 60 '7 Tage
'Sound abspielen
.ReminderPlaySound = True
'Erinnerung setzen
.ReminderSet = True
'Kategorie = Farbe
.categories = "dringend"
'Speichern
.Save
'In Spalte 21 (U) ID eintragen
wksSheet.Cells(lngRow, 21) = .EntryID
End With
Set objTermin = Nothing
'Ende Wenn Termin nicht schon vorhanden, dann
End If
'Wenn in Spalte 7 (G) ein Datum steht, dann
End If
Next lngRow
Fin:
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
Set objFolder = Nothing
Set objTermin = Nothing
Set objOutApp = Nothing
If Err.Number = 0 Then MsgBox "Termine nach Outlook ?bertragen!"
End Sub
Private Function fncPointExist(ByVal objTMP As Object, _
ByVal strSubject As String) As Boolean
Dim objItem As Object
For Each objItem In objTMP.Items
If objItem.Subject = strSubject Then fncPointExist = True
Next
End Function
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
anbei mal mit einem wöchentlichen Termin. Machst einfach ...yearly draus und müsstest die Daten noch aus Zellen entnehmen, ich hab das zum Test nur fest drin. Relevant für die Serie ist im Prinzip dieser Teil:
Code:
'woechentliche Serie bilden
With .GetRecurrencePattern
.PatternStartDate = #9/20/2020#
.PatternEndDate = #12/12/2020#
.RecurrenceType = olRecursWeekly
End With
oben hab ich dann auch die Variablendeklarationen angepasst.
. \\\|/// Hoffe, geholfen zu haben. ( ô ô ) Grüße, André aus G in T ooO-(_)-Ooo (Excel 97-2019+365)
Zitat:Es wurde aber der End-Termin nicht beachtet, es wurden 64 Termine eingetragen => 64 Jahre.
Hätte ich auch gerne noch, natürlich bei bester Gesundheit Andererseits, Du weißt doch, bei Luther waren's 2017 500 Jahre :15:
Hier mal zwei weitere Parameter. Da ist dann auch die Reihenfolge relevant. Du musst am Anfang erst mal den "Button" bzw. die Eigenschaft für das Enddatum setzen, dann klappt es mit Anfang und Ende. Occurrences wäre die Alternative für die Anzahl Termine, dann lässt Du NeEndDate weg.
