Automatisch Mails versenden
16.04.2021 15:37:26
Ulf
ich brauche einmal Eure geschätzte Hilfe. Ich fülle über eine Userform (Sheet 1) eine dynamische Tabelle (Sheet 2) in die Spalten B bis J. In Spalte A kommt eine fortlaufende Nummer. In Spalte H steht ein Ablaufdatum, dass ich nun für meine Anfrage an Euch benötige.
In der Spalte K wird über eine Formel
=WENNFEHLER(DATEDIF(HEUTE();$H2;"D")
Sub Workbook_Open()
Wie kann ich das erreichen, da nicht zu jedem Zeitpunkt dort eine Mailadresse steht und die Tabelle ja auch weiter anwächst.
Wäre sehr erfreut über Eure Hilfe.
Hier ist mein bisheriger Versuch, der allerdings an den Überschriften in der ersten Zeile scheitert, weil diese mitgezählt werden.
Sub Erinnerungsmail()
Dim MailAdresse As String, Betreff As String
Dim olApp As Object
Dim strOldBody As String
Dim i As Long
Sheets(2).Activate
For i = 1 To ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
Set olApp = CreateObject("Outlook.Application")
Set oLMail = olApp.CreateItem(0)
'Standard Text
Betreff = "Ablaufdatum "
Anrede = "Sehr geehrte Damen und Herren,
Text1 = "für "
Text2 = " läuft ab. Soll "
Text3 = " werden."
MA = Cells(i, 15) 'Name
'Mailtext
Text = Anrede & Text1 & MA & Text2 & MA & Text3
'Infomail
With oLMail
.GetInspector.Display
strOldBody = .htmlBody
.To = Cells(i, 13)
.Subject = Betreff
.htmlBody = "" & Text & "" & strOldBody
.Display
.Send
End With
Set olApp = Nothing
Set oLMail = Nothing
ActiveSheet.Cells(i, 12).Value = "x"
Application.Wait (Now + TimeValue("0:00:05"))
Next i
Sheets(1).Activate
End Sub