Tip: andere talen zijn Google-Vertaald. Je kunt het English versie van deze link.
Log in
x
or
x
x
Registreren
x

or

Hoe e-mail te verzenden als de vervaldatum is bereikt in Excel?

Zoals hieronder te zien is, als de vervaldatum in kolom C minder is dan of gelijk is aan 7 dagen (huidige datum is 2017 / 9 / 13), stuur dan een e-mailherinnering naar de opgegeven ontvanger in kolom A met gespecificeerde inhoud in kolom B. Hoe het te bereiken? Dit artikel biedt een VBA-methode om dit in details af te handelen.

Stuur een e-mail als de vervaldatum is behaald met VBA-code

Tabblad Office Schakel bewerken en browsen met tabbladen in Office in en maak uw werk veel eenvoudiger ...
Kutools voor Excel - De beste Office-productiviteitstool lost de meeste van uw Excel-problemen op
  • Alles hergebruiken: Voeg de meest gebruikte of complexe formules, grafieken en al het andere toe aan uw favorieten en hergebruik ze snel in de toekomst.
  • Meer dan 20-tekstfuncties: Nummer uit tekststring halen; Een deel van de tekst extraheren of verwijderen; Nummers en valuta's omzetten in Engelse woorden ...
  • Tools samenvoegen: Meerdere werkmappen en bladen in één; Meerdere cellen / rijen / kolommen samenvoegen zonder gegevens te verliezen; Dubbele rijen en som samenvoegen ...
  • Split gereedschap: Gegevens splitsen in meerdere bladen op basis van waarde; Eén werkmap naar meerdere Excel-, PDF- of CSV-bestanden; Eén kolom naar meerdere kolommen ...
  • Plakken overslaan Verborgen / gefilterde rijen; Tel en som op achtergrondkleur; Maak een verzendlijst en Verzend e-mails op waarde van Cell...
  • Super filter: Maak geavanceerde filterschema's en pas deze toe op alle bladen; Soort per week, dag, frequentie en meer; filters door vetgedrukt, formules, commentaar ...
  • Meer dan 300 krachtige functies; Werkt met Office 2007-2019 en 365; Ondersteunt alle talen; Eenvoudig inzetbaar in bedrijf; Volledige functionaliteit 60-daagse gratis proefversie.

Stuur een e-mail als de vervaldatum is behaald met VBA-code


Doe als volgt een e-mailherinnering als de vervaldatum in Excel is bereikt.

1. druk de anders + F11 toetsen tegelijkertijd om de Microsoft Visual Basic voor toepassingen venster.

2. In de Microsoft Visual Basic voor toepassingen venster, klik alstublieft bijvoegsel > module. Kopieer en plak vervolgens de onderstaande VBA-code in het modulevenster.

VBA-code: stuur een e-mail als de vervaldatum in Excel is gesloten

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

Notes: De lijn Als CDate (xRgDateVal) - Datum <= 7 En CDate (xRgDateVal) - Datum> 0 Dan betekent in de VBA-code dat de vervaldatum groter moet zijn dan 1-dag en kleiner dan of gelijk aan 7-dagen. Je kunt het veranderen zoals je nodig hebt.

3. druk op het F5-sleutel om de code uit te voeren. In de eerste opduiken Kutools for Excel dialoogvenster, selecteer het bereik van de vervaldatum en klik vervolgens op de OK knop. Zie screenshot:

4. Dan de tweede Kutools for Excel dialoogvenster verschijnt, selecteer het corresponderende kolombereik dat de e-mailadressen van de ontvangers bevat en klik op de OK knop. Zie screenshot:

5. Als laatste Kutools for Excel dialoogvenster, selecteer de inhoud die u wilt weergeven in de hoofdtekst van de e-mail en klik op de OK knop.

Vervolgens wordt automatisch een e-mailbericht met de opgegeven ontvanger, onderwerp en hoofdtekst weergegeven als de vervaldatum in kolom C kleiner is dan of gelijk is aan 7 dagen. Klik op de Verstuur om de e-mail te verzenden.

Notes:

1. Elke gemaakte e-mail komt overeen met een vervaldatum. Als er bijvoorbeeld drie vervaldatums aan de criteria voldoen, worden er automatisch drie e-mailberichten gemaakt.

2. Deze code wordt niet geactiveerd als er geen datums aan de criteria voldoen.

3. De VBA-code werkt alleen als u Outlook gebruikt als uw e-mailprogramma.


Gerelateerde artikelen:


Kutools voor Excel - De beste Office-productiviteitstool Verhoog uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Coderen van cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula Bar (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken op gefilterd bereik...
  • Cellen / rijen / kolommen samenvoegen zonder gegevens te verliezen; Inhoud gesplitste cellen; Combineer dubbele rijen / kolommen... voorkomen dubbele cellen; Ranges vergelijken...
  • Selecteer Dupliceren of Uniek rijen; Selecteer Lege rijen (alle cellen zijn leeg); Super Find en Fuzzy Find in veel werkboeken; Willekeurig selecteren ...
  • Exacte kopie Meerdere cellen zonder formule-referentie te wijzigen; Automatisch referenties maken naar meerdere vellen; Voeg kogels toe, Selectievakjes en meer ...
  • extract Text, Tekst toevoegen, verwijderen op positie, Verwijder de spatie; Subtotalen voor paging maken en afdrukken; Converteren tussen cellen Inhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerde sortering per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Volledige functionaliteit 60-daagse gratis proefversie.
kte-tab 201905

Tabblad Office Brengt interface met tabbladen naar Office en maakt uw werk veel eenvoudiger

  • Bewerken en lezen met tabbladen inschakelen in Word, Excel, PowerPoint, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster, in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en verlaagt dagelijks honderden muisklikken voor u!
Officetab onderaan
Say something here...
symbols left.
You are guest ( Sign Up? )
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.
    Muru · 2 days 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.
    Tina · 3 days 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.
    Mindie · 16 days 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 · 24 days 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 · 26 days 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 months 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 months 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 · 2 months 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.
    David Brändle · 3 months 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 · 4 months 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.
    SerMFe · 4 months ago
    Hi,

    I have a question,

    If I want to select a prederterminate range of cells, how could i modify the code in this part:

    xLastRow = xRgDate.Rows.Count
    Set xRgDate = xRgDate(1)

    Toset automaticatly the cells?

    Thank you :)
  • To post as a guest, your comment is unpublished.
    LaThalia Y Echols · 5 months ago
    I am new to VBA. Is there a way to automatically run this program whenever the file is opened?
    • To post as a guest, your comment is unpublished.
      SerMFe · 4 months ago
      Yes, with


      Private Sub Workbook_Open()
      *Enter code here*
      End Sub
  • To post as a guest, your comment is unpublished.
    L Echols · 5 months ago
    Hello, I am new to VBA. Is there a way to have this program automatically run whenever the file is opened?
    • To post as a guest, your comment is unpublished.
      crystal · 4 months ago
      Hi L Echols,
      For automatically running the code when the file is opened, please double click to open the ThisWorkbook code window (locates in the left side of the Microsoft Visual Basic for Applications window) , select Workbook from the first drop-down list, and then copy the above VBA code (except the first and the last line) into the code window and paste between the given two lines. See the below attached screenshot:
      • To post as a guest, your comment is unpublished.
        Daniel Lee · 4 months ago
        This is awesome. I was wondering if there is a way to run the code without having to select the KuTools values every time? For clarification, I inputted this code and now whenever I open the workbook I still have to highlight the same columns. Is there a way to input the code to run a check on the same columns every time - as long as no edits to workbook have been made - to run the check and formulate an email based off said check? Thank you in advance.
      • To post as a guest, your comment is unpublished.
        Danny · 4 months ago
        This is awesome. I was wondering if there is a way to run the code without having to select the KuTools values every time? For clarification, I inputted this code and now whenever I open the workbook I still have to highlight the same columns. Is there a way to input the code to run a check on the same columns every time - as long as no edits to workbook have been made - to run the check and formulate an email based off said check? Thank you in advance.
        • To post as a guest, your comment is unpublished.
          crystal · 4 months ago
          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
  • To post as a guest, your comment is unpublished.
    Dinesh B S · 5 months ago
    in the body i want the column a,b,c value in a table format, like the expired date once reached in the body column i want to print a,b,c cells details in table format
  • To post as a guest, your comment is unpublished.
    Sounder P · 7 months ago
    Hello Sir,

    This is very much helpful. I need 2 more enhancement in the same codes. I have to click on send button every time, it is fine as long as I have 10 email to be sent, what if I >25 emails to be sent in a single day. So please give me a code to send e-mail automatically upon selecting Due date , Recipient, Subject etc.

    Also please provide me with the code to add " CC" option as well


    Thanks

    Sounder P
    • To post as a guest, your comment is unpublished.
      crystal · 6 months ago
      Good day,
      Please try the below VBA code, hope I can help. Thanks for commenting.

      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 xRgCC = Application.InputBox("Please select the CC recipients?email column:", "KuTools For Excel", , , , , , 8)
      If xRgCC 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 xRgCC = xRgCC(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
      xRgCCVal = xRgCC.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
      .Cc = xRgCCVal
      .HTMLBody = xMailBody
      .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.
    Sam Engel · 7 months ago
    Hi, I am using a modified version of this code, and I am rather new to VBA. I was curious if there was a possibility for when the email were to be sent, that the macro would be able to mark an X, or if someone had Complete, that an email would not send. I hope this all makes sense. Any help is very greatly appreciated. Little background, I am using this tool to run a due date check at 30 days, 60 days, and overdue. I want 1 email to go out at 30 days, 1 at 60 days, and then overdue as well. I am running this off of a VB script I wrote, so that I could automate it daily. Thanks!
  • To post as a guest, your comment is unpublished.
    S. Engel · 7 months ago
    Hi, I am using a modified version of this code, and I am rather new to VBA. I was curious if there was a possibility for when the email were to be sent, that the macro would be able to mark an X, or if someone had Complete, that an email would not send. I hope this all makes sense. Any help is very greatly appreciated.

    Little background, I am using this tool to run a due date check at 30 days, 60 days, and overdue. I want 1 email to go out at 30 days, 1 at 60 days, and then overdue as well. I am running this off of a VB script I wrote, so that I could automate it daily. Thanks!
  • To post as a guest, your comment is unpublished.
    Fabrisquie Borges · 8 months ago
    Correctly, it was not with Mr. Ivan, but with Mr. Austin.
    Thank you.
  • To post as a guest, your comment is unpublished.
    Fabrisquie Borges · 8 months ago
    Hello,
    Mr. Crystal, in your last conversation with Mr. Ivan, he asked you for the code to send e-mail every time the spreadsheet is opened instead of entering the codes each time.
    I need the same code, same situation, can you help please?
  • To post as a guest, your comment is unpublished.
    Rodrigo Vicente · 10 months ago
    Thank you very much for the contribution. I would like to know how to use fixed column selection without having to use kutools? that is, leave default columns of dates, receipts, and warnings?
    • To post as a guest, your comment is unpublished.
      crystal · 10 months ago
      Good day,
      The below VBA code can help you. Please have a try.

      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 = Range("C2:C4") 'Please reference the due date column
      If xRgDate Is Nothing Then Exit Sub
      Set xRgSend = Range("A2:A4") 'Please reference the recipients?email column
      If xRgSend Is Nothing Then Exit Sub
      Set xRgText = Range("B2:B4") Enter the column with reminded content in your email
      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.
        niti · 8 months ago
        Dear Crytal,

        Thank for your sharing.

        I'm a beginner and I have a problem with code.

        xMailBody = ""
        xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
        xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
        xMailBody = xMailBody & ""

        The text is not go to new line.
        Could you please help.

        Thanks
        • To post as a guest, your comment is unpublished.
          crystal · 8 months ago
          Ni niti,
          You need to add the line vbCrLf = "<br><br>" in front of the coldes.
          Such as:
          vbCrLf = "<br><br>"
          xMailBody = ""
          xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
          xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
          xMailBody = xMailBody & ""
  • To post as a guest, your comment is unpublished.
    Ivan · 10 months ago
    Hi guys,


    Macro is great but I would like to ask something - if you have someone on the list without any date how to modifiy the vba code to exclude that guy? Now the code generates e-mails even for the guys without any date.


    Thanks!
    • To post as a guest, your comment is unpublished.
      crystal · 10 months ago
      Hi Lvan,
      The code has been updated with the problem solving, please have a try. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    austin · 11 months ago
    I have got excel to send the email, but can I set this so it sends an email every time I open up excel instead of selecting the columns each time.

    I have a workbook with 24 pages so am looking to email automatically when the workbook is opened up.


    Many thanks.
    • To post as a guest, your comment is unpublished.
      crystal · 11 months ago
      Hi,
      Do you mean check for the due date automatically across the workbook and send email when the workbook is openned up?
  • To post as a guest, your comment is unpublished.
    Dick Borman · 11 months ago
    Dont get it working. Using Office 365 so Outlook and Excel should be tight enough. Like in the post from "schou" 4 monts ago, it works up to step 5 but then nothing.
    A solution to this?
  • To post as a guest, your comment is unpublished.
    Edward Snyder · 11 months ago
    I need this to work across all worksheets in a workbook the future date will be manually entered in the same cell on every sheet and new sheets are created daily. I also need the worksheet name in the email so I will know which sheet is due
  • To post as a guest, your comment is unpublished.
    Diyaa · 1 years ago
    can we just input the details one time and the emails can be sent automatically, instead of always needing to select the columns?
    • To post as a guest, your comment is unpublished.
      crystal · 11 months ago
      Hi Diyaa,
      If you don't want to manually select the columns, please apply the below VBA code.
      Note: You onlyneed to select the due dates column after applying the code.

      Public Sub CheckAndSendMail()
      'Updated by Extendoffice 2017/9/14
      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
      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 = xRgDate.Offset(I - 1).Value
      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 = "Hi there" & vbNewLine & vbNewLine & _
      "This is line 1" & vbNewLine & _
      "This is line 2"
      Set xMailItem = xOutApp.CreateItem(0)
      With xMailItem
      .To = "Email Address"
      .CC = ""
      .BCC = ""
      .Subject = "send by cell value test"
      .Body = xMailBody
      .Display 'or use .Send
      End With
      Set xMailItem = Nothing
      End If
      Next
      Set xOutApp = Nothing
      End Sub
      • To post as a guest, your comment is unpublished.
        Thomas · 6 months ago
        Hello,
        I'm also pretty much of a beginner and I would like to ask another question for your great Sub.

        How can I send an email only if a certain mail-adress is in the regarding cell?

        I need this, because in my excel-tool i implemented some buttons for each person, who needs a reminder.

        Thank you very much in advance!!

        Thomas
  • To post as a guest, your comment is unpublished.
    Robert · 1 years ago
    This code froze my excel program when I ran it. Is it memory intensive?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Robert,
      The problem you mentioned does not appear in my case. May I have your Office version?
  • To post as a guest, your comment is unpublished.
    Maria · 1 years ago
    Me viene muy bien gracias por el aporte, solo me falta como puedo hacerlo automaticamente sin necesidad de hacerlo manualmente el envio del correo.
  • To post as a guest, your comment is unpublished.
    schou · 1 years ago
    I used your VBA code for sending emails based on a cell value but it doesn’t work.
    Everything up until step 5 works but no email is sent. Can anyone help me with this?
  • To post as a guest, your comment is unpublished.
    Brandon Pillay · 1 years ago
    Thank you for sharing.


    How would you add Cc inputs or multiple recipients?
    • To post as a guest, your comment is unpublished.
      schou · 1 years ago
      Hi Brandon,

      Sorry to comment on your post without an answer but were you able to get the VBA code to send an email?