Note: The other languages of the website are Google-translated. Back to English
Belépek  \/ 
x
or
x
Regisztráció  \/ 
x

or

Hogyan lehet e-mailt küldeni, ha az Excel határidejét betartotta?

Amint az alábbi képernyőképen látható, ha a C oszlopban szereplő esedékesség kevesebb, mint 7 nap (a jelenlegi dátum 2017/9/13), akkor küldjön e-mailes emlékeztetőt az A oszlopban megadott címzettnek a B. oszlopban megadott tartalommal. Hogyan lehet elérni? Ez a cikk egy VBA-módszert ismertet a részletek kezelésére.

Küldjön e-mailt, ha a határidő lejárt VBA kóddal


Küldjön e-mailt, ha a határidő lejárt VBA kóddal


Kérjük, tegye a következőket, hogy e-mailben küldjön emlékeztetőt, ha az esedékességi dátumot betartotta az Excel.

1. megnyomni a más + F11 gombok egyszerre a Microsoft Visual Basic for Applications ablak.

2. Ban,-ben Microsoft Visual Basic for Applications ablakot, kérjük kattintson betétlap > Modulok. Ezután másolja és illessze be az alábbi VBA kódot a Modul ablakba.

VBA kód: E-mail küldése, ha az esedékesség dátuma le van zárva az Excelben

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

Megjegyzések: A vonal Ha CDate (xRgDateVal) - dátum <= 7 És CDate (xRgDateVal) - Dátum> 0 Ekkor a VBA kód azt jelenti, hogy az esedékességnek 1 napnál hosszabbnak és 7 napnál rövidebbnek vagy egyenlőnek kell lennie. Szükség szerint megváltoztathatja.

3. nyomja meg a F5 billentyű a kód futtatásához. Az első felbukkanó Kutools for Excel párbeszédpanelen válassza ki az esedékesség oszloptartományát, majd kattintson a gombra OK gomb. Lásd a képernyőképet:

4. Ezután a második Kutools for Excel megjelenik a párbeszédpanel, válassza ki a megfelelő oszloptartományt, amely tartalmazza a címzettek e-mail címét, majd kattintson a gombra OK gomb. Lásd a képernyőképet:

5. Az utolsóban Kutools for Excel párbeszédpanelen válassza ki az e-mail törzsében megjeleníteni kívánt tartalmat, majd kattintson a gombra OK gombot.

Ezután automatikusan létrehoz egy e-mailt, amelyben a megadott címzett, tárgy és test felsorolásra kerül, ha a C. oszlopban szereplő esedékesség legfeljebb 7 nap. Kattintson a gombra Küldés gombra az e-mail elküldéséhez.

Megjegyzések:

1. Minden létrehozott e-mail megfelel egy esedékességi dátumnak. Például, ha három határidő felel meg a feltételeknek, akkor automatikusan három e-mail jön létre.

2. Ez a kód nem indul el, ha nincsenek olyan dátumok, amelyek megfelelnek a feltételeknek.

3. A VBA kód csak akkor működik, ha az Outlook programot használja e-mail programként.


Kapcsolódó cikkek:


A legjobb irodai termelékenységi eszközök

A Kutools for Excel megoldja a legtöbb problémát, és 80% -kal növeli a termelékenységet

  • újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
  • Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
  • Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
  • Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
  • Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
  • Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
  • Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
  • Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
  • Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2019 és 365. Támogatja az összes nyelvet. Könnyen telepíthető a vállalkozásba vagy szervezetbe. 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.
kte tab 201905

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és minden nap több száz kattintással csökkenti az egér kattintását!
officetab alja
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