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.
