Note: The other languages of the website are Google-translated. Back to English
Einloggen  \/ 
x
or
x
Registrieren  \/ 
x

or

Wie sende ich eine E-Mail, wenn das Fälligkeitsdatum in Excel erreicht wurde?

Wenn das Fälligkeitsdatum in Spalte C kleiner oder gleich 7 Tagen ist (aktuelles Datum ist der 2017), senden Sie wie in der Abbildung unten gezeigt eine E-Mail-Erinnerung an den angegebenen Empfänger in Spalte A mit dem angegebenen Inhalt in Spalte B. Wie erreicht man das? Dieser Artikel enthält eine VBA-Methode, mit der Sie ausführlich darauf eingehen können.

Senden Sie eine E-Mail, wenn das Fälligkeitsdatum mit dem VBA-Code erreicht wurde


Senden Sie eine E-Mail, wenn das Fälligkeitsdatum mit dem VBA-Code erreicht wurde


Bitte gehen Sie wie folgt vor, um eine E-Mail-Erinnerung zu senden, wenn das Fälligkeitsdatum in Excel erreicht wurde.

1. Drücken Sie die Taste Andere + F11 Tasten gleichzeitig zum Öffnen der Microsoft Visual Basic für Applikationen Fenster.

2. In dem Microsoft Visual Basic für Applikationen Fenster, bitte klicken Insert > Modul. Kopieren Sie dann den folgenden VBA-Code und fügen Sie ihn in das Modulfenster ein.

VBA-Code: E-Mail senden, wenn das Fälligkeitsdatum in Excel geschlossen ist

Public Sub CheckAndSendMail()
'Updated by Extendoffice 2018/11/22
    Dim xRgDate As Range
    Dim xRgSend As Range
    Dim xRgText As Range
    Dim xRgDone As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xLastRow As Long
    Dim vbCrLf As String
    Dim xMailBody As String
    Dim xRgDateVal As String
    Dim xRgSendVal As String
    Dim xMailSubject As String
    Dim i As Long
    On Error Resume Next
    Set xRgDate = Application.InputBox("Please select the due date column:", "KuTools For Excel", , , , , , 8)
    If xRgDate Is Nothing Then Exit Sub
    Set xRgSend = Application.InputBox("Please select the recipients?email column:", "KuTools For Excel", , , , , , 8)
    If xRgSend Is Nothing Then Exit Sub
    Set xRgText = Application.InputBox("Select the column with reminded content in your email:", "KuTools For Excel", , , , , , 8)
    If xRgText Is Nothing Then Exit Sub
    xLastRow = xRgDate.Rows.count
    Set xRgDate = xRgDate(1)
    Set xRgSend = xRgSend(1)
    Set xRgText = xRgText(1)
    Set xOutApp = CreateObject("Outlook.Application")
    For i = 1 To xLastRow
        xRgDateVal = ""
        xRgDateVal = xRgDate.Offset(i - 1).Value
        If xRgDateVal <> "" Then
        If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
            xRgSendVal = xRgSend.Offset(i - 1).Value
            xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
            vbCrLf = "<br><br>"
            xMailBody = "<HTML><BODY>"
            xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
            xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
            xMailBody = xMailBody & "</BODY></HTML>"
            Set xMailItem = xOutApp.CreateItem(0)
            With xMailItem
                .Subject = xMailSubject
                .To = xRgSendVal
                .HTMLBody = xMailBody
                .Display
                '.Send
            End With
            Set xMailItem = Nothing
        End If
    End If
    Next
    Set xOutApp = Nothing
End Sub

Einschränkungen: Die Linie Wenn CDate (xRgDateVal) - Datum <= 7 Und CDate (xRgDateVal) - Datum> 0 Dann bedeutet der VBA-Code, dass das Fälligkeitsdatum größer als 1 Tag und kleiner oder gleich 7 Tage sein muss. Sie können es nach Bedarf ändern.

3. Drücken Sie Sie F5-Taste zum Ausführen des Codes. Beim ersten Auftauchen Kutools for Excel Wählen Sie im Dialogfeld den Spaltenbereich für das Fälligkeitsdatum aus und klicken Sie auf OK Taste. Siehe Screenshot:

4. Dann die zweite Kutools for Excel Das Dialogfeld wird angezeigt. Wählen Sie den entsprechenden Spaltenbereich aus, der die E-Mail-Adressen der Empfänger enthält, und klicken Sie auf OK Taste. Siehe Screenshot:

5. Im letzten Kutools for Excel Wählen Sie im Dialogfeld den Inhalt aus, den Sie im E-Mail-Text anzeigen möchten, und klicken Sie dann auf OK .

Anschließend wird automatisch eine E-Mail mit dem angegebenen Empfänger, Betreff und Text erstellt, wenn das Fälligkeitsdatum in Spalte C 7 Tage oder weniger beträgt. Bitte klicken Sie auf die senden Schaltfläche zum Senden der E-Mail.

Einschränkungen:

1. Jede erstellte E-Mail entspricht einem Fälligkeitsdatum. Wenn beispielsweise drei Fälligkeitstermine die Kriterien erfüllen, werden automatisch drei E-Mail-Nachrichten erstellt.

2. Dieser Code wird nicht ausgelöst, wenn keine Daten vorhanden sind, die die Kriterien erfüllen.

3. Der VBA-Code funktioniert nur, wenn Sie Outlook als E-Mail-Programm verwenden.


In Verbindung stehende Artikel:


Die besten Tools für die Office-Produktivität

Kutools für Excel löst die meisten Ihrer Probleme und erhöht Ihre Produktivität um 80%

  • Wiederverwendung: Schnell einfügen komplexe Formeln, Diagramme und alles, was du vorher benutzt hast; Zellen verschlüsseln mit Passwort; Mailingliste erstellen und E-Mails senden ...
  • Super Formula Bar (leicht mehrere Textzeilen und Formeln bearbeiten); Layout lesen (leichtes Lesen und Bearbeiten einer großen Anzahl von Zellen); In gefilterten Bereich einfügen...
  • Zellen / Zeilen / Spalten zusammenführen ohne Daten zu verlieren; Inhalt geteilter Zellen; Kombinieren Sie doppelte Zeilen / Spalten... doppelte Zellen verhindern; Bereiche vergleichen...
  • Wählen Sie Duplizieren oder Eindeutig Reihen; Wählen Sie Leere Zeilen (alle Zellen sind leer); Super Find und Fuzzy Find in vielen Arbeitsmappen; Zufällige Auswahl ...
  • Exakte Kopie Mehrere Zellen ohne Änderung der Formelreferenz; Referenzen automatisch erstellen zu mehreren Blättern; Aufzählungszeichen einfügen, Kontrollkästchen und mehr ...
  • Text extrahieren, Text hinzufügen, Nach Position entfernen, Leerzeichen entfernen;; Paging-Zwischensummen erstellen und drucken; Inhalt und Kommentare zwischen Zellen konvertieren...
  • Superfilter (Speichern und Anwenden von Filterschemata auf andere Blätter); Erweiterte Sortierung nach Monat / Woche / Tag, Häufigkeit und mehr; Spezialfilter fett, kursiv ...
  • Kombinieren Sie Arbeitsmappen und Arbeitsblätter;; Tabellen basierend auf Schlüsselspalten zusammenführen; Daten in mehrere Blätter aufteilen; Batch-Konvertierung von xls, xlsx und PDF...
  • Mehr als 300 leistungsstarke Funktionen. Unterstützt Office / Excel 2007-2019 und 365. Unterstützt alle Sprachen. Einfache Bereitstellung in Ihrem Unternehmen oder Ihrer Organisation. Vollständige Funktionen 30 Tage kostenlose Testversion. 60 Tage Geld-zurück-Garantie.
kte tab 201905

Office Tab Bringt die Oberfläche mit Registerkarten in Office und erleichtert Ihnen die Arbeit erheblich

  • Aktivieren Sie das Bearbeiten und Lesen von Registerkarten in Word, Excel und PowerPoint, Publisher, Access, Visio und Project.
  • Öffnen und erstellen Sie mehrere Dokumente in neuen Registerkarten desselben Fensters und nicht in neuen Fenstern.
  • Steigert Ihre Produktivität um 50% und reduziert täglich Hunderte von Mausklicks für Sie!
officetab unten
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Shagufta · 29 days ago
    @crystal Hello,
    I have also followed your steps but sill it doesnot send automatic email when i open the spread sheet. Please guide me
  • To post as a guest, your comment is unpublished.
    rajesh · 1 months ago
    Hi, could you please re-publish the code that to send an email with different columns in single email (ex- Recipient 1 with columns 3,5,10..etc and Recipient 2 with columns 7,9,12..etc),
  • To post as a guest, your comment is unpublished.
    Christine · 1 months ago
    Hi, I am very happy to find these codes and it works. May I know if I wish to change the "Date" into number of days example >= 90 days (take reference to a cell instead) as I have already set the formula to count numbers of days as of to-date. Is it possible? I am very new to codes. Appreciate your guidance. Thanks
  • To post as a guest, your comment is unpublished.
    Miriam · 4 months ago
    Hi,

    This code is great for what I need! :) Could you please help me to change the following code If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then to set a specific date instead of the 7 days ? I would like to receive alerts for each line, in which the due date is <=31/08/2021.

    Any help would be greatly appreciated.

    Thanks, Miriam
  • To post as a guest, your comment is unpublished.
    crystal · 6 months ago
    @Deanda Sorry, you can't open an email without the date, recipients and content.
  • To post as a guest, your comment is unpublished.
    Simon · 6 months ago
    @crystal Hi Crystal,

    I have followed the method above but still when I open the spreadsheet it doesn't send the email automatically.


  • To post as a guest, your comment is unpublished.
    Deanda · 6 months ago
    hi, why can't the email open after blocking the date, recipients, and content?
    Thanks!
  • To post as a guest, your comment is unpublished.
    byron · 6 months ago
    @crystal Hi Crystal, thanks for your reply.
    In fact, i have modified the vbCrLf = " " into vbCrLf = "<br><br>" then solved the problem, thanks!
  • To post as a guest, your comment is unpublished.
    crystal · 6 months ago
    @byron Hi byron,
    You can add & vbCrLf after "Dear" to place the "Dear" and "Text" in separate lines.
  • To post as a guest, your comment is unpublished.
    byron · 7 months ago
    @crystal thanks to your great code!
    One more Q, currently "Dear " & "Text " are in same line, may i know how to be in different line?
    e.g. "Dear..."
    "Text..."
  • To post as a guest, your comment is unpublished.
    crystal · 7 months ago
    @BriSte In the worksheet you will send emails based on due dates, please do as follows:
    1. Press the Alt + F11 keys to open the Micrsoft Visual Basic for Applications window;
    2. In the opened window, double click This Workbook to open the ThisWorkbook (Code) editor;
    3. Copy the above code and paste into the code editor, and the press Alt + A keys to close the window;
    4. Now you need to save the workbook as an Excel Macro-enabled Workbook: click File > Save As > Browse. In the Save As window, select a folder to save the file, name it as you need in the File name box, choose Excel Macro-Enabled Workbook from the Save as type drop-down, and then click Save.
    From now on, when opening this workbook, the code will be triggered automatically.
  • To post as a guest, your comment is unpublished.
    BriSte · 7 months ago
    @crystal
    Ho do I get this to auto run when I open up Excel
    BriSte
  • To post as a guest, your comment is unpublished.
    Bae · 8 months ago
    Hi, can I add the cc email the code and how? please help me
  • To post as a guest, your comment is unpublished.
    crystal · 8 months ago
    @BriSte Hi BriSte,
    If you want to send an email automatically, please run the below code. Thank you.

    Private Sub Workbook_Open()
    Dim xRgDate As Range
    Dim xRgSend As Range
    Dim xRgText As Range
    Dim xRgDone As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xLastRow As Long
    Dim vbCrLf As String
    Dim xMailBody As String
    Dim xRgDateVal As String
    Dim xRgSendVal As String
    Dim xMailSubject As String
    Dim i As Long
    On Error Resume Next
    Set xRgDate = Application.InputBox("Please select the due date column:", "KuTools For Excel", , , , , , 8)
    If xRgDate Is Nothing Then Exit Sub
    Set xRgSend = Application.InputBox("Please select the recipients?email column:", "KuTools For Excel", , , , , , 8)
    If xRgSend Is Nothing Then Exit Sub
    Set xRgText = Application.InputBox("Select the column with reminded content in your email:", "KuTools For Excel", , , , , , 8)
    If xRgText Is Nothing Then Exit Sub
    xLastRow = xRgDate.Rows.count
    Set xRgDate = xRgDate(1)
    Set xRgSend = xRgSend(1)
    Set xRgText = xRgText(1)
    Set xOutApp = CreateObject("Outlook.Application")
    For i = 1 To xLastRow
    xRgDateVal = ""
    xRgDateVal = xRgDate.Offset(i - 1).Value
    If xRgDateVal <> "" Then
    If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
    xRgSendVal = xRgSend.Offset(i - 1).Value
    xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
    vbCrLf = "

    "
    xMailBody = ""
    xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
    xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
    xMailBody = xMailBody & ""
    Set xMailItem = xOutApp.CreateItem(0)
    With xMailItem
    .Subject = xMailSubject
    .To = xRgSendVal
    .HTMLBody = xMailBody
    .Display
    '.Send
    End With
    Set xMailItem = Nothing
    End If
    End If
    Next
    Set xOutApp = Nothing
    End Sub
  • To post as a guest, your comment is unpublished.
    BriSte · 8 months ago
    Hi could you please re-publish the code that sends an email automatically
    BriSre
    • To post as a guest, your comment is unpublished.
      crystal · 8 days ago
      @Shagufta Hi,
      In the workbook containing the data you will send email based on, press the Alt + F11 keys to open the Microsoft Visual Basic for Applications window.
      In this window, double click ThisWorkbook in the Project pane, and then copy the below code into the opening ThisWorkbook (code) window (see the attached picture below). Save the code and then press the Alt + Q keys to close the Microsoft Visual Basic for Applications window.
      Now you need to save the workbook as an Excel Macro-Enabled Workbook: click File > Save As, choose a folder to save the file, in the Save As dialog box, select Excel Macro-Enabled Workbook from the Save as type drop down list, and then click the Save button.
      From now on, when open the workbook, the corresponding dialog box will pop up for you to select certain field data for sending email.

      Private Sub Workbook_Open()
      Dim xRgDate As Range
      Dim xRgSend As Range
      Dim xRgText As Range
      Dim xRgDone As Range
      Dim xOutApp As Object
      Dim xMailItem As Object
      Dim xLastRow As Long
      Dim vbCrLf As String
      Dim xMailBody As String
      Dim xRgDateVal As String
      Dim xRgSendVal As String
      Dim xMailSubject As String
      Dim i As Long
      On Error Resume Next
      Set xRgDate = Application.InputBox("Please select the due date column:", "KuTools For Excel", , , , , , 8)
      If xRgDate Is Nothing Then Exit Sub
      Set xRgSend = Application.InputBox("Please select the recipients?email column:", "KuTools For Excel", , , , , , 8)
      If xRgSend Is Nothing Then Exit Sub
      Set xRgText = Application.InputBox("Select the column with reminded content in your email:", "KuTools For Excel", , , , , , 8)
      If xRgText Is Nothing Then Exit Sub
      xLastRow = xRgDate.Rows.Count
      Set xRgDate = xRgDate(1)
      Set xRgSend = xRgSend(1)
      Set xRgText = xRgText(1)
      Set xOutApp = CreateObject("Outlook.Application")
      For i = 1 To xLastRow
      xRgDateVal = ""
      xRgDateVal = xRgDate.Offset(i - 1).Value
      If xRgDateVal <> "" Then
      If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
      xRgSendVal = xRgSend.Offset(i - 1).Value
      xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
      vbCrLf = ""

      xMailBody = ""
      xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
      xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
      xMailBody = xMailBody & ""
      Set xMailItem = xOutApp.CreateItem(0)
      With xMailItem
      .Subject = xMailSubject
      .To = xRgSendVal
      .HTMLBody = xMailBody
      .Display
      '.Send
      End With
      Set xMailItem = Nothing
      End If
      End If
      Next
      Set xOutApp = Nothing
      End Sub
  • To post as a guest, your comment is unpublished.
    crystal · 9 months ago
    @Fevro1 Hi,
    This line xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf in the code helps to add the corresponding recipients email address after "Dear".
  • To post as a guest, your comment is unpublished.
    Fevro1 · 9 months ago
    This code is great! I've used the 'Range' code you described in the comments to select the cells required for the email within a certain range, however I am trying to add the recipients name (A2:A110) to the mail body directly after "Dear". I cannot seem to figure out what line of code I need to write in to make this possible. Any help would be much appreciated. Thank you!
  • To post as a guest, your comment is unpublished.
    Rholloway · 9 months ago
    @crystal Hi Crystal, I have used one of the below comments and answers to amend the code to send when it opens and to use a predetermined range so that it is automated. What I am looking for is an addition to mark the line of data as sent and then not read that line in the future. Thank you!
  • To post as a guest, your comment is unpublished.
    crystal · 10 months ago
    @RHolloway Hi,
    The code won't send emails automatically when opening the workbook. You need to manually run it and specify the corresponding ranges.
  • To post as a guest, your comment is unpublished.
    RHolloway · 10 months ago
    Hi, this is great thank you!


    How can I avoid the code sending emails every time I open the workbook, if it has already sent an email. For example how could I add a column that the code marks 'S' in when it sends an email and then checks that column before sending the email?
  • To post as a guest, your comment is unpublished.
    crystal · 10 months ago
    @Jhimber0905 Hi,
    Please try the below VBA, and don't forget to modify the ranges based on your own data.

    Public Sub CheckAndSendMail()
    Dim xRgDate As Range
    Dim xRgSend As Range
    Dim xRgText As Range
    Dim xRgDone As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xLastRow As Long
    Dim vbCrLf As String
    Dim xMailBody As String
    Dim xRgDateVal As String
    Dim xRgSendVal As String
    Dim xMailSubject As String
    Dim xStrRang As String
    Dim i As Long
    On Error Resume Next
    'Please specify the due date range
    xStrRang = "C2:C5"
    Set xRgDate = Range(xStrRang)
    'Please specify the recipients email address range
    xStrRang = "A2:A5"
    Set xRgSend = Range(xStrRang)
    'Specify the range with reminded content in your email
    xStrRang = "B2:B5"
    Set xRgText = Range(xStrRang)

    xLastRow = xRgDate.Rows.Count
    Set xRgDate = xRgDate(1)
    Set xRgSend = xRgSend(1)
    Set xRgText = xRgText(1)
    Set xOutApp = CreateObject("Outlook.Application")
    For i = 1 To xLastRow
    xRgDateVal = ""
    xRgDateVal = xRgDate.Offset(i - 1).Value
    If xRgDateVal <> "" Then
    If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
    xRgSendVal = xRgSend.Offset(i - 1).Value
    xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
    vbCrLf = "

    "
    xMailBody = ""
    xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
    xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
    xMailBody = xMailBody & ""
    Set xMailItem = xOutApp.CreateItem(0)
    With xMailItem
    .Subject = xMailSubject
    .To = xRgSendVal
    .HTMLBody = xMailBody
    .Display
    '.Send
    End With
    Set xMailItem = Nothing
    End If
    End If
    Next
    Set xOutApp = Nothing
    End Sub
  • To post as a guest, your comment is unpublished.
    Reet Josan · 10 months ago
    Hi ,
    I need a code which automatically send email if today is a due date on the sheet..
    one more thing i want to confirm my sheet is always open in minimise position with outlook open in minimised positiontoo on a computer which is on 24/7 . i just want once i add all anniversary figures in the sheet and add the code, 5 people should be able to get email every time on the day automatically.
    is this posible. if yes please help me and send the code.
    Thanks in advance..
    Reet
  • To post as a guest, your comment is unpublished.
    crystal · 10 months ago
    @Jason Hi Jason,
    If you want to send the email automatically without popping up, please replace the line .Display with .Send.
  • To post as a guest, your comment is unpublished.
    Jhimber0905 · 10 months ago
    I love this code, but I don't like that every single time I have to select the cells I want to email. Is there a way to just choose a range so that I don't have to fill-in the KuTools answers each time? I have KUtools BTW.
  • To post as a guest, your comment is unpublished.
    Jason · 10 months ago
    This is fantastic. Thank you for posting this. I do have one question....

    When I put in the code, it is working and it is automatically creating emails in outlook to be sent. That said, I still have to click on each of the emails and send them. Is there VBA code that would make the emails get sent automatically?
  • To post as a guest, your comment is unpublished.
    crystal · 11 months ago
    @mohamed aleem Hi,
    You don't need to install Kutools, after adding the VBA to the Module window, press the F5 key to run the code. Then follow the instruction to finish it step by step.
  • To post as a guest, your comment is unpublished.
    mohamed aleem · 1 years ago
    is there a videos explain how to run a code because i cannot know how to proceed this issue ? and i need to ask somerhing, i have to install the Kutools to send tha mail or to enable code is run ?

  • To post as a guest, your comment is unpublished.
    Raj · 1 years ago
    @crystal Dear Crystal, While selecting the dates column, Can multiple cells in different columns be selected?
  • To post as a guest, your comment is unpublished.
    Kayden · 1 years ago
    @crystal Hello Crystal,
    I'm having an issue with automatically sending email once file is opened. For instance, I have all due date info on Sheet1. However, if I save and close the file when I was working on Sheet2, as soon as I open the file, the values to send emails will be based on Sheet2 and not on Sheet1. I only have module added on Sheet1 and ThisWorkbook. I think having same vba on ThisWorkbook triggers to send automatic emails on whichever sheet I have it open at the moment. How can I restrict the VBA to pull value from specific sheet and also send emails when the file is opened? Thank you very much for your help in advance!
  • To post as a guest, your comment is unpublished.
    barbara · 1 years ago
    @Alex Hola! Pudiste solucionar esto? Estoy necesitando lo mismo.. gracias!
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Muru Hi Muru,
    If you want to stop triggering emails, please get into the Microsoft Visual Basic for Applications window, click the Break button (next to the Run button).
    And you can click the Run button to activate the code again.
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Tina Hi Tina,
    Which Excel version are you using?
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Goodrich Hi Mindie,
    Which Excel version are you using?
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Kailing Hi,
    The code stops working when the Excel file is closed.
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @Kayden Hi Kayden,
    The code in this article may do you a favor: https://www.extendoffice.com/documents/excel/4656-excel-send-email-based-on-cell-value.html
    Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    crystal · 1 years ago
    @SerMFe Hi,
    If you don't want to manually select ranges every time when applying the code, please use the below code.

    Public Sub CheckAndSendMail()
    'Updated by Extendoffice 2019/12/10
    Dim xRgDate As Range
    Dim xRgSend As Range
    Dim xRgText As Range
    Dim xRgDone As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xLastRow As Long
    Dim vbCrLf As String
    Dim xMailBody As String
    Dim xRgDateVal As String
    Dim xRgSendVal As String
    Dim xMailSubject As String
    Dim i As Long
    On Error Resume Next
    Set xRgDate = Range("C2: C4")
    If xRgDate Is Nothing Then Exit Sub
    Set xRgSend = Range("A2: A4")
    If xRgSend Is Nothing Then Exit Sub
    Set xRgText = Range("B2:B4")
    If xRgText Is Nothing Then Exit Sub
    xLastRow = xRgDate.Rows.Count
    Set xRgDate = xRgDate(1)
    Set xRgSend = xRgSend(1)
    Set xRgText = xRgText(1)
    Set xOutApp = CreateObject("Outlook.Application")
    For i = 1 To xLastRow
    xRgDateVal = ""
    xRgDateVal = xRgDate.Offset(i - 1).Value
    If xRgDateVal <> "" Then
    If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
    xRgSendVal = xRgSend.Offset(i - 1).Value
    xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
    vbCrLf = "

    "
    xMailBody = ""
    xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
    xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
    xMailBody = xMailBody & ""
    Set xMailItem = xOutApp.CreateItem(0)
    With xMailItem
    .Subject = xMailSubject
    .To = xRgSendVal
    .HTMLBody = xMailBody
    .Display
    '.Send
    End With
    Set xMailItem = Nothing
    End If
    End If
    Next
    Set xOutApp = Nothing
    End Sub
  • To post as a guest, your comment is unpublished.
    theebanraj03@gmail.com · 1 years ago
    @crystal Hi Crystal,

    Thanks for the codes as it is very much helpful. But how to make the code work if I'm using outlook.office.com?
  • To post as a guest, your comment is unpublished.
    Benjamin · 1 years ago
    Hi I'm a beginner here, may I know what does the following do?

    xRgDateVal = xRgDate.Offset(i - 1).Value
  • To post as a guest, your comment is unpublished.
    Muru · 1 years ago
    I'm Beginner here, I have tried the given VBA code and its works well.
    can I stop triggering an email if the case is closed before meeting the due date?
  • To post as a guest, your comment is unpublished.
    Muru · 1 years ago
    hi
    I'm a beginner to VBA. I have tried the given format and its works well.

    Sometimes my clients meet earlier than my due date so in this situation how to stop the email triggering?

    Regards
    Muru
  • To post as a guest, your comment is unpublished.
    Tina · 1 years ago
    I am trying to use this code but when I run it, it just comes up with "Compile error: Invalid outside procedure". Do you think you could help please?
    Many thanks
    Tina
  • To post as a guest, your comment is unpublished.
    Goodrich · 1 years ago
    I copied the VBA code you provided for this, but it keeps grabbing the header row and not the cells with the content I need. Can you help me with this?
  • To post as a guest, your comment is unpublished.
    matt · 1 years ago
    Hi,

    I have set up a code to filter a column to tomorrows date (works fine) then to put the filtered workbook into an email as a PDF (works ok) then filter this back to all (Works ok) For some reason the pdf comes through with no data and I cant for the life of me figure out why. Please can you help? Code below.

    Currently on row 122 so this should be covered with the below?

    Sub CallMacros()
    Call FilterTomorrow1
    Call Email_ActiveSheet_As_PDF
    Call FilterAll1
    End Sub
    Sub FilterTomorrow1()
    '
    ' FilterTomorrow1 Macro
    ' Filter delivery date from all to tomorrows date
    '

    '
    ActiveSheet.Range("$A$3:$T$329").AutoFilter Field:=6, Criteria1:=3, _
    Operator:=11, Criteria2:=0, SubField:=0
    ActiveWindow.SmallScroll Down:=-500
    End Sub
    Sub Email_ActiveSheet_As_PDF()

    'Do not forget to change the email ID
    'before running this code

    Dim OlApp As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileFullPath As String

    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    End With

    TempFilePath = Environ$("temp") & "\"

    TempFileName = ActiveSheet.Name & "-" & Format(Now, "dd-mmm-yy") & "Tomorrows Deliveries.pdf"

    On Error GoTo err
    With ActiveSheet
    .ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=FileFullPath, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    End With

    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)

    On Error Resume Next
    With NewMail
    .To = "my email"
    .CC = ""
    .BCC = ""
    .Subject = "Tomorrows Deliveries"
    .Body = "Please see attached delivery schedule for tomorrow"
    .Attachments.Add FileFullPath '--- full path of the pdf where it is saved
    .Send 'or use .Display to show you the email before sending it.
    End With
    On Error GoTo 0

    Kill FileFullPath

    Set NewMail = Nothing
    Set OlApp = Nothing

    .ScreenUpdating = True
    .EnableEvents = True
    End With
    MsgBox ("Email has been Sent Successfully")
    Exit Sub
    err:
    MsgBox err.Description

    End Sub
    Sub FilterAll1()
    '
    ' FilterAll1 Macro
    ' Filter delivery due date from tomorrows date to select all
    '

    '
    ActiveSheet.Range("$A$3:$T$329").AutoFilter Field:=6
    End Sub
  • To post as a guest, your comment is unpublished.
    Kailing · 1 years ago
    Hi, can the reminder still be sent when the excel file is closed?
  • To post as a guest, your comment is unpublished.
    Jill · 1 years ago
    Hi,

    I would like to add another column in the code that allows me to write and separate message in the subject box, and another message for the email content. Can this be done?
  • To post as a guest, your comment is unpublished.
    Kayden · 1 years ago
    Hello,

    Can you modify this VBA to send automatic emails based on cell value instead of due dates? For instance, Column C2 will be a numeric value instead of a date; once it falls below XX number, then it initiates an email with subject The Park Project is due soon. Thank you!
  • To post as a guest, your comment is unpublished.
    parvana · 1 years ago
    Hello, thank a lot for the VBA code. I run it, but I have a problem. I tried several dates and realized the outlook is sending messages 1 day after the calibration date. I pu 7/14/2019
    7/15/2019
    7/16/2019
    7/17/2019
    7/18/2019
    7/19/2019
    7/20/2019
    7/21/2019 dates and after running the VBA code the excel sent me an email only for 7/19/2019; 7/20/2019; 7/21/2019 dates. Since today is 7/18/2019, it means the emails are 1 day after the calibration date. I wanted the messages to be sent the week before the due date.
  • To post as a guest, your comment is unpublished.
    davidbraendle66@gmail.com · 1 years ago
    Ich habe die VAB in der XLS Tabelle hinterlegt mit der korrekten Mail Adresse.
    Leider funktioniert es nicht. Woran kann es liegen? Gerne höre-lese ich von Ihnen. Vielen Dank.
  • To post as a guest, your comment is unpublished.
    Alex · 1 years ago
    Buenos días! ¿que modificación tendría que realizar para dejar seleccionadas las celdas con la información de fecha, texto y correo y no tener que seleccionarlas cada vez que se activa la macro?

    también me gustaría saber como introducir un CC, es decir, poder poner a otra persona en copia del correo. Gracias!
  • To post as a guest, your comment is unpublished.
    crystal · 2 years ago
    @Danny Hi Danny,
    Please try the below code and change the ranges as you need.

    Public Sub CheckAndSendMail()
    'Updated by Extendoffice 2019/5/17
    Dim xRgDate As Range
    Dim xRgSend As Range
    Dim xRgText As Range
    Dim xRgDone As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xLastRow As Long
    Dim vbCrLf As String
    Dim xMailBody As String
    Dim xRgDateVal As String
    Dim xRgSendVal As String
    Dim xMailSubject As String
    Dim i As Long
    On Error Resume Next
    Set xRgDate = Range("C2: C4")
    If xRgDate Is Nothing Then Exit Sub
    Set xRgSend = Range("A2: A4")
    If xRgSend Is Nothing Then Exit Sub
    Set xRgText = Range("B2:B4")
    If xRgText Is Nothing Then Exit Sub
    xLastRow = xRgDate.Rows.Count
    Set xRgDate = xRgDate(1)
    Set xRgSend = xRgSend(1)
    Set xRgText = xRgText(1)
    Set xOutApp = CreateObject("Outlook.Application")
    For i = 1 To xLastRow
    xRgDateVal = ""
    xRgDateVal = xRgDate.Offset(i - 1).Value
    If xRgDateVal <> "" Then
    If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
    xRgSendVal = xRgSend.Offset(i - 1).Value
    xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
    vbCrLf = "

    "
    xMailBody = ""
    xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
    xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
    xMailBody = xMailBody & ""
    Set xMailItem = xOutApp.CreateItem(0)
    With xMailItem
    .Subject = xMailSubject
    .To = xRgSendVal
    .HTMLBody = xMailBody
    .Display
    '.Send
    End With
    Set xMailItem = Nothing
    End If
    End If
    Next
    Set xOutApp = Nothing
    End Sub