Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1652to1656
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

Email wenn Datum überfällig

Email wenn Datum überfällig
06.11.2018 09:57:06
Florian
Hallo zusammen,
hier ein Screenshot meiner Tabelle.
Wenn das Datum in Spalte H überschritten wurde soll automatisch eine Email an die Adresse in Spalte O gesendet werden. Vergleichsdatum ist Zelle I1.
Das ganz sollte wenn möglich automtisch bei öffnen der Datei geprüft werden und ggf. die entsprechende Email raus hauen. Das ganz sollte über die komplette Arbeitsmappe funktionieren und nicht nur in einem Blatt.
Meine Frage ist ob sowas möglich ist und mir jemand damit helfen kann.
Vielen Dank für die Antworten
Userbild

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Email wenn Datum überfällig
06.11.2018 10:25:42
Florian
Leider hab ich es nicht hinbekommen. Nach dem ich deine meine Tabelle gebastelt habe wie Sie sein soll, wollte ich mein Problem damit genauer erklären.
AW: Email wenn Datum überfällig
06.11.2018 10:43:36
Bernd
Servus Florian,
ok, dann mach mer halt die Anpassung anhand eines Screenshots...

Sub Mail()
Dim ws As Worksheet
Dim i As Integer
For Each ws In ThisWorkbook.Worksheets
With ws
For i = 4 To .Cells(Rows.Count, 8).End(xlUp).Row
If .Cells(1, 9).Value > .Cells(i, 8).Value Then
' Mailversand
Dim MyOutApp As Object
Dim MyMessage As Object
Set MyOutApp = CreateObject("Outlook.application")
Set MyMessage = MyOutApp.createitem(0)
With MyMessage
.to = .Cells(i, 15).Value
.Subject = "Titel"
.Body = "Nachricht"
.Display ' Mail anzeigen ohne automatischen Versand
'.Send ' Mail automatisch senden ohne vorherige Anzeige
End With
Set MyMessage = Nothing
Set MyOutApp = Nothing
' Mailversand ENDE
End If
Next i
End With
Next ws
End Sub
Weitere Anpassungen nur noch gegen Bereitstellung deiner Datei als Upload.
Grüße, Bernd
Anzeige
AW: Email wenn Datum überfällig
06.11.2018 11:24:41
Florian
Vielen Dank für deine Mühe.
Anbei die Datei. Ich verstehe es leider nicht.
Aber man kann ja immer dazu lernen.
https://www.herber.de/bbs/user/125184.xlsm
AW: Email wenn Datum überfällig
06.11.2018 11:51:52
Bernd
Servus Florian,
kopiere einfach den folgenden Code im VBA-Editor der Datei unter "DieseArbeitsmappe" und teste es mal.

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim i As Integer
For Each ws In ThisWorkbook.Worksheets
With ws
For i = 4 To .Cells(Rows.Count, 8).End(xlUp).Row
If .Cells(1, 9).Value > .Cells(i, 8).Value Then
If .Cells(i, 15).Value  "" Then
' Mailversand
Dim MyOutApp As Object
Dim MyMessage As Object
Set MyOutApp = CreateObject("Outlook.application")
Set MyMessage = MyOutApp.createitem(0)
With MyMessage
.To = ws.Cells(i, 15).Value
.Subject = "Titel"
.Body = "Nachricht"
.Display ' Mail anzeigen ohne automatischen Versand
'.Send ' Mail automatisch senden ohne vorherige Anzeige
End With
Set MyMessage = Nothing
Set MyOutApp = Nothing
' Mailversand ENDE
Else
MsgBox "Fehlende Email-Adresse in Tabelle: " & ws.Name & " Zelle: " & ws.Cells(i,  _
15).Address
End If
End If
Next i
End With
Next ws
End Sub
Hinweise:
- Den Mailtitel und den Mailtext solltest du noch anpassen
- die Mail wird dir bei diesem Makro (zum Testen) nur angezeigt, du musst selbst noch auf senden drücken
- wenn das Ergebnis deiner Vorstellung entspricht, dann entferne das Hochkomma (" ' ") vor ".Send" und setze es vor ".Display"
Grüße, Bernd
Anzeige
AW: Email wenn Datum überfällig
06.11.2018 12:01:51
Bernd
Servus,
kleine Korrektur, damit die 100%-Themen nicht auch per Mail angezählt werden:

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim i As Integer
For Each ws In ThisWorkbook.Worksheets
With ws
.Select
For i = 4 To .Cells(Rows.Count, 8).End(xlUp).Row
If .Cells(1, 9).Value > .Cells(i, 8).Value Then ' Datumskriterium
If .Cells(i, 15).Value  "" Then           ' Mailadresse vorhanden
If .Cells(i, 12).Value  100 Then      ' Status 
Grüße, Bernd
AW: Email wenn Datum überfällig
06.11.2018 12:14:09
Florian
WOW.
1000 Dank dafür, ich würde sowas auch gerne können.
Eine Sache ist mir nur aufgefallen, und zwar springt es immer in das letzte Tabellenblatt anstatt auf dem aktuellen Blatt zu bleiben.
Ist es auch möglich das die eingabe der Email freiwillig ist? Also wenn keine Email-Adresse eingegeben kommt auch keine Fehlermeldung.
Anzeige
AW: Email wenn Datum überfällig
06.11.2018 12:20:47
Bernd
Servus Florian,
(fast) alles ist möglich.
Lösche dazu nur folgende Zeilen:

With ws
    .Select
For i = 4 To .Cells(Rows.Count, 8).End(xlUp).Row

=> .Select raus

If .Cells(i, 15).Value  "" Then           ' Mailadresse vorhanden
If .Cells(i, 12).Value  100 Then      ' Status  Else
            MsgBox "Fehlende Email-Adresse in Tabelle: " & ws.Name & " Zelle: " & ws. _
Cells(i,  _
15).Address
            End If
End If

=> Else und
=> Msgbox raus
Grüße, Bernd
Anzeige
AW: Email wenn Datum überfällig
06.11.2018 13:01:42
Florian
Perfekt ich bin bin dir so Dankbar.
AW: Email wenn Datum überfällig
07.11.2018 14:59:47
Florian
Hallo Bernd,
ist es auch Möglich eine 2 Email-Abfrage zu machen, so dass es eine Erinnerungsmail gibt 2 Wochen vor Ablauf des Enddatums. (Wunsch meines Kunden)
Vielen Dank für deine Hilfe
AW: Email wenn Datum überfällig
09.11.2018 11:55:50
Bernd
Servus Florian,
wie, du vertickst die Software und verdienst damit Geld?! :-)
Generell ist das natürlich auch möglich.
Grüße, Bernd
AW: Email wenn Datum überfällig
09.11.2018 12:24:24
Bernd
Servus Florian,
teste mal...

Private Sub Workbook_Open()
Dim ws As Worksheet
Dim i As Integer
For Each ws In ThisWorkbook.Worksheets
With ws
For i = 4 To .Cells(Rows.Count, 8).End(xlUp).Row
If .Cells(i, 15).Value  "" Then                       ' Mailadresse vorhanden
If .Cells(i, 12).Value  100 Then                  ' Status  .Cells(i, 8).Value Then ' Datumskriterium
' Mailversand
Dim MyOutApp As Object
Dim MyMessage As Object
Set MyOutApp = CreateObject("Outlook.application")
Set MyMessage = MyOutApp.createitem(0)
With MyMessage
.To = ws.Cells(i, 15).Value
.Subject = "Titel"
.Body = "Nachricht"
.Display                                    ' Mail anzeigen
'.Send                                      ' Mail senden
End With
Set MyMessage = Nothing
Set MyOutApp = Nothing
' Mailversand ENDE
ElseIf .Cells(1, 9).Value 
Grüße, Bernd
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige