Anzeige
Archiv - Navigation
1840to1844
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bedingung für Automatische E Mail

Bedingung für Automatische E Mail
29.07.2021 16:50:05
Excel
Hallo Liebes Forum,
ich tüftle seit Tagen an folgendem Problem:
Ich habe in einer Liste Datumsangaben die die Fälligkeit, bzw. einen Vertragsablauf an diesem Datum anzeigen. (Spalte C)
Es sollen automatische Mails mit der Datei im Anhang generiert werden, sobald gewisse Zeitpunkte überschritten sind.
Dies soll an zwei unterschiedlichen Zeitpunkten geschehen quasi als Redundanz.
Warnstufe "Reminder 1"
Prüfung Termin 1: Differenz Aktuelles Tagesdatum zum zukünftigen Ablaufdatum liegt zwischen 7 und 14 Tagen
Warnstufe "Reminder 2"
Prüfung Termin 2: Differenz Aktuelles Tagesdatum zum zukünftigen Ablaufdatum liegt zwischen 0 und 7 Tagen
Darüber hinaus soll dann ein Feld gefüllt werden, welches den Status der aktuellen Warnstufe wiedergibt z.B. durch Text "Reminder 1" bzw. "Reminder 2" (Spalte D)
Die generelle Grundfunktion des automatischen Mailversandes bei der Prüfung EINER der beiden Warnstufen habe ich noch hinbekommen.
Auch das füllen des Statusfeldes mit der jeweiligen Warnstufe habe ich mir zurechtgebastelt.
Das Problem ist jetzt, wenn ich täglich die Liste öffne, werden natürlich auch jeden Tag diese Mails generiert da nur das Datum geprüft wird.
Dies wollte ich nun unterbinden indem ich Bedingungen zum auslösen des automatischen Versandes festlege.
Ich dachte daran zum Beispiel das Feld des "Status" in Spalte D dazu als Bezug zu nehmen.
Wenn Feld = "leer" , dann prüfe Zeiträume zu Termin 1 + 2
Wenn Feld enthält "Reminder 1" dann prüfe Zeiträume zu Termin 2
Wenn Feld enthält "Reminder 2" dann keine mail senden
Ich kapituliere nun dabei,
1. die zu prüfenden Bedingungen (Spalte D) zur Ausführung des Makros zu implementieren,
2. sowie beide Warnstufen abzufragen.
Ich kann immer nur einen Zeitraum prüfen, den zweiten fragt das Makro dann nicht mehr ab.
Da ich keinerlei VBA Kenntnisse habe hoffe ich auf Eure Hilfe,
Vielen Dank vorab für Eure Antworten.
LG Frauke
hier der upload dazu
https://www.herber.de/bbs/user/147373.xlsm

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bedingung für Automatische E Mail
29.07.2021 17:53:12
ralf_b
Wenn du keinerlei VBA Kenntnisse hast, wer hat dann das Makro angepasst?
Unter Verwendung der Differenzspalte vermeide ich in dem folgenden Code die separate Berechnung der Differenz.
Das Mailverssenden ist nun eine extra sub. Leider kann ich es nicht testen, da kein Outlook. Somit ist das dein Job.

Public Sub CheckAndSendMail()
'Updated by Extendoffice 2018/11/22
'Update by Ralf_b 2021/07/29
Dim xRgDate As Range, xRgSend As Range, xRgText As Range
Dim xRgDone As Range, xRgDiff As Range
Dim xRowCount As Long
Dim i      As Long
Set xRgDate = Range("C2:C5")                  'Please reference the due date column
If xRgDate Is Nothing Then Exit Sub
Set xRgSend = Range("A2:A5")                  'Please reference the recipients?email column
If xRgSend Is Nothing Then Exit Sub
Set xRgText = Range("B2:B5")                  'Enter the column with reminded content in your email
If xRgText Is Nothing Then Exit Sub
Set xRgDone = Range("D2:D5")                  'Sign Status Reminder
If xRgDate Is Nothing Then Exit Sub
Set xRgDiff = Range("F2:F5")                  'Differenz zu Heute
If xRgDiff Is Nothing Then Exit Sub
xRowCount = xRgDate.Rows.Count
For i = 1 To xRowCount
If xRgDate(i)  "" Then
Select Case xRgDiff(i)
Case 8 To 14
If xRgDone(i) = "Reminder 1" Then
Else
Call sendamail(xRgSend(i), xRgText(i), xRgDate(i).Text)
xRgDone(i) = "Reminder 1"
End If
Case 0 To 7
If xRgDone(i) = "Reminder 2" Then
Else
Call sendamail(xRgSend(i), xRgText(i), xRgDate(i).Text)
xRgDone(i) = "Reminder 2"
End If
End Select
End If
Next
Set xRgDate = Nothing:     Set xRgSend = Nothing:     Set xRgText = Nothing
Set xRgDone = Nothing:    Set xRgDiff = Nothing
End Sub
Sub sendamail(sAddr As String, sNr As String, sDatum As String)
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
Dim xMailSubject As String
Dim xMailsent As String
On Error GoTo 0
Set xOutApp = CreateObject("Outlook.Application")
xMailBody = xMailBody & vbCrLf & "Hallo liebes Team, " & vbCrLf
xMailBody = xMailBody & "der Vertrag mit der Nummer " & sNr
xMailBody = xMailBody & " läuft demnächst aus, bitte prüfen. Vielen Dank." & vbCrLf
xMailBody = xMailBody & " Beste Grüße" & vbCrLf
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = sNr & " on " & sDatum
.To = sAddr
.CC = "Frauke.excel@web.de"
.HTMLBody = xMailBody
.Attachments.Add ThisWorkbook.FullName
.Display
'.Send
End With
Set xMailItem = Nothing
End Sub
gruß
rb
Anzeige
AW: Bedingung für Automatische E Mail
30.07.2021 14:24:39
Excel
Hallo Ralf,
wie gesagt habe ich mich bereits durchs Netz gelesen und alles per copy & paste, sowie trail & error zusammengebastelt :-)
Vielen lieben Dank für deine rasche Hilfe, es funktioniert einwandfrei !!!!!!!!
Daaaaaankeeeeee !!!!! you made my day :-)))
LG
Frauke
danke für die rückmeldung -owT
30.07.2021 17:37:06
ralf_b
AW: danke für die rückmeldung -owT
02.08.2021 19:42:56
Excel
Hallo Ralf,
habe nun nach meinem Urlaub das ganze in meine Liste auf der Arbeit eingetragen und es klappt einwandfrei.
Hätte da nun eine Kleinigkeit, welche mir vorher nicht so ins Auge gefallen ist.
Der Zeilenumbruch funktioniert nicht, i.e. der Body der Mail wird als ein Satz verfasst.
Kannst Du mir hier nochmal auf die Sprünge helfen?
Vielen Dank
LG Frauke
Anzeige
AW: Bedingung für Automatische E Mail
29.07.2021 17:56:24
Yal
Hallo Frauke,
trenne die Prüfung der Datum von dem Versand.
Mach den Versand separat.
Achte auf die Identierung (Lesbarkeit)
Wenn Variable sich nicht ändern -> Kosntanten.

Option Explicit
Private Sub Workbook_Open()
Fälligkeit_prüfen
End Sub
Public Sub Fälligkeit_prüfen()
Dim Z
With Worksheets("Tabelle1")
'prüfe Datum und füge Reminder
For Each Z In .Range(.Range("C2"), .Range("C99999").End(xlUp)).Cells
Select Case DateDiff("d", CDate(Z.Value), Now)
Case Is  "" Then
Mail_senden Z.EntireRow.Range("A1"), Z.EntireRow.Range("B1"), Z.EntireRow.Range("C1")
End If
Next
End With
End Sub
Private Sub Mail_senden(Empfänger As String, Vertragsnummer As String, Datum As String)
Dim xOutApp As Object
Dim xMailItem As Object
Const LF = "<br><br>"
Const L1 = "Hallo liebes Team, "
Const L2 = "der Vertrag mit der Nummer "
Const L3 = " läuft demnächst aus, bitte prüfen. Vielen Dank."
Const L4 = " Beste Grüße" & vbCrLf
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = Vertragsnummer & " on " & Datum
.To = Empfänger
.CC = "Frauke.excel@web.de"
.HTMLBody = L1 & LF & L2 & Vertragsnummer & L3 & LF & L4 & LF
.Attachments.Add ThisWorkbook.FullName
.Display
'.Send
End With
Set xMailItem = Nothing
Set xOutApp = Nothing
End Sub
VG
Yal
Anzeige
AW: Bedingung für Automatische E Mail
30.07.2021 14:33:36
Excel
Hallo Yal,
vielen Dank für deine prompte Antwort.
Leider erhalte ich eine Fehlermeldung 'Laufzeitfehler 13 Typenunverträglichkeit.
Bezieht sich auf die Reihe : Select Case DateDiff("d", CDate(Z.Value), Now)
Und die Stati werden versetzt in der Tabelle eingefügt und nicht hinter dem jeweiligen Ablaufdatum.
Ist aber soweit nicht tragisch da ein anderer user mir bereits weitergeholfen hat.
Vielen lieben Dank trotzdem für Deine Bemühungen und die rasche Antwort.
LG
Frauke
AW: Bedingung für Automatische E Mail
30.07.2021 18:37:39
Yal
Hallo Frauke,
wie aus der Initialisierung der For-Schleife zu entnehmen ist, bezieht sich Z auf alle Zellen der Spalte C zwischen C2 und letzte befüllte in Spalte C.
Wenn eine von diese Zelle etwas enthält, was nicht als Datum interpretierbar ist, dann kommt wegen CDate eine Typenunverträglichkeit. Sinnvoll wäre eine vorige Prüfung des Typen.
Der Versatz kann ich nicht nachvollziehen. Notfalls Offset verwenden: null Zeilen nach unten & 1 Spalte nach recht von Z eintragen.

'prüfe Datum und füge Reminder
For Each Z In .Range(.Range("C2"), .Range("C99999").End(xlUp)).Cells
If IsDate(Z.Value) Then
Select Case DateDiff("d", CDate(Z.Value), Now)
Case Is 
VG
Yal
Anzeige
AW: Bedingung für Automatische E Mail
02.08.2021 19:46:17
Excel
Hallo Yal,
seltsam, da in der Spalte ab C2 ausschliesslich nur Datumsangaben stehen. (ich prüfe die Formate nochmal)
Das mit dem Versatz hat sich nun erledigt.
Vielen Dank nochmal für dein Feedback.
LG
Frauke

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige