Automatically generate email for outlook based on date

Good day,

I need to generate an email in combination with Outlook. The email should be generated based on a date (if it is older than today's date, then generate the email). Once generated, it should somehow mark the person so that when another person is opening the file too, it is not generating the same email again (spam).
The email text should include some information from the Excel file, so replace some words with information from the specific cell.

I added a detailed explenation into the sheet "(Emails)". I would be very thankful if anyone can help me or at least give me some good hints. I put much effort into learning VBA, but since I'm very new (learning for a week now), this is nothing I can do on my own at the moment, but I'm in need of it.

Thanky ou in advance, I appreciate every tip, trick and support!

Greetings

Will you always send one email per row? Or do you want to aggregate emails for the same email address, such that you send info for two rows at once?

Thanks for the hint! No, it is totally fine to generate one email per row. Normally the list is not too long (it's just for the working students and interns), most likely they will only receive one email.

That they receive multiple emails a day would only happen if I set the same date for a job to re-search and if it is the same manager. This most likely doesn't happen. :-)

Thank you, I'll check it out!

I'll check it as soon as I'm home since I'm not allowed to download it at my work computer. Thank you so much in advance!

I made the update to ask up front if you want to proceed with sending the email, and how many are ready to be sent. In the email code, one line ".display," ensures the email will display before being sent. If you don't want to preview the email, then comment out the " '.display" line and uncomment the ".send" line. Or you can activate both if you would like.

Please Login or Register  to view this content.

On the workbook module, I used this code:

Please Login or Register  to view this content.

I also added a Sent column to track what has been Emailed.

It is so amazing, thank you so much! If we ever meet, I owe you some beers ;-)

Just small things:
1) Is it 1. of all possible that in the email text after "Mit freundlichen Grüßen" it automatically adds the name of the user who is opening the Excel file? Since we're all using our business accounts, it is the correct full name.
2) If there is no reminder to be send, do not open the popup window when opening the Excel file
3) If there is only one reminder to be send, there should be a slightly different text, if more than 1 another text (because of singular-plural).

Thank you so, so much!

I already fixed it on my own and I'm proud, haha

Here`s how I did it:

HTML Code: 

Option Explicit

Sub SendEmailCheck()
'This code checks for rows with past days and looks at column N for blank value to count how many emails to send
    Dim i, Cnt, Rslt As Integer
    Application.ScreenUpdating = False
    Cnt = 0
    For i = 6 To Worksheets("Mitarbeiter").Cells(Rows.Count, "M").End(xlUp).Row
        If ((Worksheets("Mitarbeiter").Cells(i, "L").Value) = "") And (Worksheets("Mitarbeiter").Cells(i, "N").Value = "" And ((Worksheets("Mitarbeiter").Cells(i, "D").Value) < Now)) Then
            Cnt = Cnt + 1
        End If
    Next i
    
    If Cnt < 1 Then Exit Sub
    
    If Cnt = 1 Then
        Rslt = MsgBox("Es ist eine Erinnerung bezüglich ablaufender Stellen zu verschicken." & vbNewLine & vbNewLine & "Email jetzt generieren?", vbYesNo + vbQuestion, "Erinnerungsmails")
        If Rslt = "6" Then
            MsgBox "Die Email wird nun generiert und in Outlook geöffnet."
        
            SendEmailsifPastDate
            
        Else
            MsgBox "Beim nächsten Öffnen erfolgt eine erneute Abfrage.", vbInformation, "Erinnerungsemails"
        End If
    End If
    If Cnt > 1 Then
        Rslt = MsgBox("Es sind " & Cnt & " Erinnerungen bezüglich ablaufender Stellen zu verschicken." & vbNewLine & vbNewLine & "Emails jetzt generieren?", vbYesNo + vbQuestion, "Erinnerungsmails")
        If Rslt = "6" Then
            MsgBox "Die Emails werden nun generiert und in Outlook geöffnet."
        
            SendEmailsifPastDate
            
        Else
            MsgBox "Beim nächsten Öffnen erfolgt eine erneute Abfrage.", vbInformation, "Erinnerungsemails"
        End If
    End If
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Sub SendEmailsifPastDate()
'This solution checks for rows with past days and looks at column N for blank value to send emails
    Dim i As Integer
    'Dim lr As Integer
    Application.ScreenUpdating = False
    'lr = Worksheets("Mitarbeiter").Cells(Rows.Count, "B").End(xlUp).Row 'For troubleshooting
    
    For i = 6 To Worksheets("Mitarbeiter").Cells(Rows.Count, "M").End(xlUp).Row
        If ((Worksheets("Mitarbeiter").Cells(i, "L").Value) <= Now) And (Worksheets("Mitarbeiter").Cells(i, "N").Value = "") Then
            Send_newemail2 (i)
            Worksheets("Mitarbeiter").Cells(i, "N").Value = Date
        End If
    Next i
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Sub Send_newemail2(i)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim rngt As Range

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'Set rngt = Worksheets("Mitarbeiter").Range("A1:M1")
    'Set rng = Worksheets("Mitarbeiter").Range("A" & i & ":M" & i)
    
    With OutMail
            '.SentOnBehalfOfName = "abc@xyz.com" for second email - needs to be active on exchange server
            .To = Worksheets("Mitarbeiter").Cells(i, "M").Value
            .CC = ""
            .Subject = "Auslaufender Vertrag, " & Worksheets("Mitarbeiter").Cells(i, "B")
            '.HTMLbody = RangetoHTML(rngt) & vbNewLine & RangetoHTML(rng)
            .Body = "Sehr geehrte/r Herr/Frau " & Worksheets("Mitarbeiter").Cells(i, "G") & "," & vbNewLine & vbNewLine & _
"auch wenn es sich hierbei um eine automatisierte Email handelt, folgender wichtiger Hinweis:Ihr/e Student/in " & Worksheets("Mitarbeiter").Cells(i, "B") & " mit der Stelle " & Worksheets("Mitarbeiter").Cells(i, "c") & " verlässt das Unternehmen laut Vertragsdatum zum " & Worksheets("Mitarbeiter").Cells(i, "E") & "." & vbNewLine & vbNewLine & _
"Sollten Sie die Stelle nachbesetzen wollen, möchten wir Sie bitten uns zeitnah eine Information zukommen zu lassen, sodass wir einen reibungslosen Ablauf gewährleisten können. " & vbNewLine & _
"Für den Fall dass wir nichts von Ihnen hören, gehen wir davon aus, dass eine Nachbesetzung für die Stelle " & Worksheets("Mitarbeiter").Cells(i, "c") & " aktuell nicht gewünscht ist." & vbNewLine & _
"Bei Fragen stehen wir Ihnen gerne jederzeit zur Verfügung." & vbNewLine & vbNewLine & _
"Mit freundlichen Grüßen" & vbNewLine & vbNewLine & _
Application.UserName
            .Display    'DELETE THIS LINE IF USING SEND
            '.send
   End With
            
   Set OutMail = Nothing
   Set OutApp = Nothing
    
End Sub