Hallo,
seit mehreren Tagen durchsuche, lese und teste ich in diversen Foren mögliche Lösungsansätze und habe bereits einige Beispiele (z.B. automatische Terminerinnerungen, Wartungspläne, Geburtstagserinnerungen, etc.) und Codes ausprobiert. Leider habe ich noch keine passende Lösung für mein Problem finden können und bin verzweifelt. Daher wollte ich hier um Hilfe bitten und hoffe, dass ich hier richtig bin und jemand mit Expertenwissen zu helfen bereit ist.
Es geht um ein Programm, dass automatisch Erinnerungsemails für anstehende Instandhaltungsaufgaben erstellt, damit diese mit einigen Tagen Vorlauf den betroffenen Stellen mitgeteilt werden. Mein erster Vorschlag war dies über den Kalender in Lotus Notes zu lösen, allerdings wurde diese Lösung explizit ausgeschlossen.
Folgende Anforderungen soll das Programm erfüllen:
- Selbstständiges Öffnen bei Autostart oder bei laufendem Rechner täglich um 12:15Uhr
- Prüfen einer Tabelle, ob eine Tätigkeit durchzuführen ist (Voraussetzung: Datum für anstehende Aufgabe minus einem jeweiligen Vorlauf entspricht HEUTE, vergangene Termin werden mit erhöhter Priorität markiert)
- Aus den entsprechenden Zeilen werden bestimmte Zellen (z.B. aus den Spalten A, C und E) ausgewählt und kopiert
- In den Zeilen sind Emailadressen hinterlegt (1x Verantwortliche/r und 1x Dateieigner) an die die Daten (Objekt, Aufgabe, Termin, Standort, Verantwortliche/r etc.) aus den kopierten Zellen übertragen werden sollen. Hier genügt es die Emails anzulegen (Programm: Lotus Notes), der Absender soll die Möglichkeit haben diese vor der Versendung zu lesen
- Nach der Erstellung aller Emails wird eine Messagbox geöffnet in der steht, wieviele Termine aktuell anstehen (entspricht der Anzahl der geöffneten Emails, eine Zahl reicht hier vollkommen aus)
- Die Exceldatei wird gespeichert und geschlossen
Es kommt dann natürlich die Frage auf, wie sichergestellt wird, dass die Emails jeweils nur einmal abgeschickt werden bzw. in der Urlaubszeit nicht untergehen. Dafür würde mir als Lösung spontan nur eine weitere Spalte einfallen, die markiert wird, sobald eine Email erstellt wurde und diese Zeilen bei der nächsten Prüfung ausgeschlossen werden.
Im Anhang habe ich ein Beispiel mit den bisherigen Ansätzen hochgeladen, vielleicht erklärt das ja die Problematik einfacher.
Für jede Anmerkung bin ich sehr, sehr dankbar!
Grüße
rl
Hier einige "Schnipsel" aus gescheiterten Versuchen:
'Automatisches Starten des Makros zwei Minuten nach Rechnerstart oder bei laufendem Rechner jeweils täglich um 12:15Uhr:
Sub Auto_open()
Application.OnTime Now + TimeValue("00:02:00"), "Autostart"
Application.OnTime TimeValue("12:15:00"), "Autostart"
'Liste durchsuchen nach Daten, die Kriterien erfüllen:
Dim Bereich As Range
Dim Zelle As Range
Dim x As Range
Set Bereich = Range("F:F")
' Emails an die Verantwortlichen öffnen, Dateieigner in den CC setzen:
For Each Zelle In Bereich
If Zelle = "" Then Exit Sub
If Zelle <= Date - Vorlauf Then
Zelle.EntireRow.Copy
.SendMail "emailadresse", "Aktuelle Instandhaltungsmaßnahme/n"
End If
Next
' Mitteilung an Dateieigner über Messagebox ausgeben:
Dim Meldung As String '
Dim Vorab As Integer 'wieviele tage vorher
Dim n As Integer
Meldung = ""
Vorab = 2 'in 2 tagen
If Date >= Worksheet.Cells().Value - Vorab Then
Meldung = Meldung & blatt.Cells(n, 9).Value
End If
If Meldung <> "" Then
MsgBox ("Folgende Wartungen sind binnen ") & Vorab & ("durchzuführen:") & Meldung
Else
MsgBox "Es stehen in " & Vorab & "keine Wartungen an"
End If
' Automatisches Beenden nachdem Dateieigner mit OK bestätigt hat.
Application.Quit
ThisWorkbook.Close
End Sub
Sub Test()
Dim a
a = Sheets("datenbasis").Columns("A:G").Find(x > 0).Row
MailDoc.sendto = Recipient & ", " & cc
MsgBox a
End Sub
Sub FindenUndKopieren()
Dim zeile
Dim x
If zeile = Sheets("datenbasis").Columns("H:H").Find(x < 0).Row Then
Else
MsgBox "nichts"
End If
End Sub
Sub Bspw1()
Dim s As Range
s = (Date <= 0)
Set s = Sheets("datenbasis").Columns("G:G").Find(s, lookat:=xlPart).Row
Bereich.Select
End Sub
Sub xy()
Dim rngZelle As Range
Dim zeile As Range
Dim zeileninhalt As Range
zeileninhalt = ActiveSheet.Range("A1:C1").Value
x = Date - 7
For Each rngZelle In ActiveSheet.Range("G:G")
If rngZelle = "" Then Exit Sub
If rngZelle <= x Then
MsgBox zeileninhalt
End If
Next
End Sub
Sub t()
Dim raZelle As Range
Set raZelle = Worksheets("1_datenbasis").Range(Cells(1, 6), Cells(IIf(IsEmpty(Cells(6, Columns.Count)), _
Cells(6, Columns.Count).End(xlToLeft).Column, Columns.Count))).Find(Date, lookat:=xlWhole)
If Not raZelle Is Nothing Then MsgBox "Achtung, heute liegt ein Termin an"
Set raZelle = Nothing
End Sub
Sub a()
MsgBox Range(EntireRow).Text
End Sub
|