Ga naar hoofdinhoud

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

Zoals te zien is in de onderstaande schermafbeelding, wordt er een e-mail verzonden naar de opgegeven ontvanger in kolom A als de vervaldatum in kolom C kleiner is dan of gelijk is aan 7 dagen (de huidige datum is bijvoorbeeld 2017/9/13). gespecificeerde inhoud in kolom B wordt weergegeven in de hoofdtekst van de e-mail. Hoe zou je kunnen doen om het te bereiken? Dit artikel bevat een VBA-code om u te helpen deze taak uit te voeren.

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


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

Ga als volgt te werk om een ​​e-mailherinnering te sturen als de vervaldatum in Excel is bereikt.

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

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

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

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

Opmerkingen: 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. U kunt het naar behoefte wijzigen.

3. druk op de F5-toets om de code uit te voeren. Bij de eerste die opduikt Kutools for Excel dialoogvenster, selecteer het kolombereik van de vervaldatum en klik vervolgens op het 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 het OK knop. Zie screenshot:

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

Vervolgens wordt automatisch een e-mail gemaakt met de opgegeven ontvanger, onderwerp en hoofdtekst als de vervaldatum in kolom C minder dan of gelijk is aan 7 dagen. Klik op het Verzenden knop om de e-mail te verzenden.

Opmerkingen:

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

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

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


Gerelateerde artikelen:

Beste Office-productiviteitstools

🤖 Kutools AI-assistent: Een revolutie teweegbrengen in de data-analyse op basis van: Intelligente uitvoering   |  Genereer code  |  Aangepaste formules maken  |  Analyseer gegevens en genereer grafieken  |  Roep Kutools-functies aan...
Populaire functies: Zoek, markeer of identificeer duplicaten   |  Verwijder lege rijen   |  Combineer kolommen of cellen zonder gegevens te verliezen   |   Ronde zonder formule ...
Super opzoeken: Meerdere criteria VLookup    VLookup met meerdere waarden  |   VOpzoeken over meerdere bladen   |   Fuzzy opzoeken ....
Geavanceerde vervolgkeuzelijst: Maak snel een vervolgkeuzelijst   |  Afhankelijke vervolgkeuzelijst   |  Multi-select vervolgkeuzelijst ....
Kolom Beheerder: Voeg een specifiek aantal kolommen toe  |  Kolommen verplaatsen  |  Schakel de zichtbaarheidsstatus van verborgen kolommen in  |  Vergelijk bereiken en kolommen ...
Uitgelichte functies: Raster focus   |  Ontwerpweergave   |   Grote formulebalk    Werkmap- en bladbeheer   |  resource Library (Auto-tekst)   |  Datumkiezer   |  Combineer werkbladen   |  Cellen coderen/decoderen    Stuur e-mails per lijst   |  Super filter   |   Speciaal filter (filter vet/cursief/doorhalen...) ...
Top 15 gereedschapsets12 Tekst Tools (toe te voegen tekst, Tekens verwijderen, ...)   |   50+ tabel Types (Gantt Chart, ...)   |   40+ Praktisch Formules (Bereken leeftijd op basis van verjaardag, ...)   |   19 Invoeging Tools (QR-code invoegen, Afbeelding invoegen vanaf pad, ...)   |   12 Camper ombouw Tools (Getallen naar woorden, Currency Conversion, ...)   |   7 Samenvoegen en splitsen Tools (Geavanceerd Combineer rijen, Gespleten cellen, ...)   |   ... en meer

Geef uw Excel-vaardigheden een boost met Kutools voor Excel en ervaar efficiëntie als nooit tevoren. Kutools voor Excel biedt meer dan 300 geavanceerde functies om de productiviteit te verhogen en tijd te besparen.  Klik hier om de functie te krijgen die u het meest nodig heeft...

Omschrijving


Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, 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 vermindert honderden muisklikken voor u elke dag!
Comments (127)
Rated 4.5 out of 5 · 1 ratings
This comment was minimized by the moderator on the site
Anyone can help me, I have come a long way with this topic, but I am running into 1 problem. In cell J:Y, a formula produces a value for how long the project will last. This changes every day because the deadline is getting closer and closer. Now I want him to automatically send me an email when there are 14 days left. This works if I simply enter 14 here myself, but not if there is a formula in it. Who can help me to automatically recognize that the 14-day period has been reached based on the formula?
This comment was minimized by the moderator on the site
I want to apply this macro to different sheets in my workbook, but each sheet is different. Adding a second module means the first one no longer works.

Could you advise me please?
This comment was minimized by the moderator on the site
Hi Annie,

The code can be applied to different worksheets, not just the current one. After running the code, select the desired worksheet tab and then the cell range.
This comment was minimized by the moderator on the site
Olá, eu trabalho com calibrações de equipamentos controlados pelo inmetro, eu fiz uma planilha com a data de vencimento da calibração de cada equipamento, é possível quando a data estiver chegando próximo ao vencimento tipo uns 30 dias, o excel enviar um email automático para que eu possa lembrar?
This comment was minimized by the moderator on the site
Bonjour , je suis nouveau sur VBA

Comment faire pour quand les dates change ?
This comment was minimized by the moderator on the site
Hi theo charvet,

Sorry I don't quite understand your question. For clarity, please attach a screenshot with your data and desired results.
This comment was minimized by the moderator on the site
Hallo Zusammen,

ich möchte an die generierte Email immer die gleiche Datei anhägen.
Ist das irgendwie machbar? Ich bedanke mich recht herzlich vorab.

Hello all,

I would like to attach always the same file to the generated email.
Is this somehow possible? Thank you very much in advance.
This comment was minimized by the moderator on the site
Hi Sandro,

You need to add the following line above the .Display line in the VBA code.
Please replace the file path with the file path of your own.
.Attachments.Add "D:\Work\Month\Dec\Word.docx"
This comment was minimized by the moderator on the site
Hallo Zusammen,

danke für den Code.

Ich möchte an die generierte Email, immer den gleichen Anhang setzten. Mit meinem primitiven Versuch:

.attachments.add "Pfad\Dateiname" bin ich leider nicht weiter gekommen.

Kann mir hier vielleicht wer helfen? :)
This comment was minimized by the moderator on the site
Hi ,

I was using this and everything goes well but after step 5 I didn't see send button , please help. I need this very urgently.
Rated 4.5 out of 5
This comment was minimized by the moderator on the site
Hi Vani,
Does the new message window pop up? The Send button displays in the message window.
If there is no eligible date, the message will not be created.
This comment was minimized by the moderator on the site
Hi!
I am trialling and it seems that always need to open and run the module for the email to be created.
How do I automatically run this even if the worksheet is not open?
This comment was minimized by the moderator on the site
Hi Mychel,
Can you describe the problem more clearly? By the way, you can't run a macro if the workbook is not open.
This comment was minimized by the moderator on the site
Hi,

Can this code be amended where it will send two lines of information to one recipient? Say i have two due dates, rather than sending two emails to the same person, can they be merged into one?

Thanks
A
This comment was minimized by the moderator on the site
Hi,
Suppose there are two tasks are assiged to the same recipient. When the due dates of these two tasks meet the conditions, an email is generated that includes the corresponding information of the tasks in the email body. Please try the following VBA code. Hope I can help.

Public Sub CheckAndSendMail2()
'Updated by Extendoffice 2022/08/23
    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, xJ As Long
    Dim vbCrLf As String
    Dim xMailBody As String
    Dim xRgDateVal As String
    Dim xRgSendVal As String
    Dim xMailSubject As String
    Dim xStrMail, xStrFind As String
    Dim xBol As Boolean
    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")
    xStrMail = ""
    For i = 1 To xLastRow
        xRgDateVal = ""
        xRgDateVal = xRgDate.Offset(i - 1).Value
        xBol = True
        If xRgDateVal <> "" Then
        If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
            xRgSendVal = xRgSend.Offset(i - 1).Value
            xStrFind = xRgSendVal & ";"
            If InStr(xStrMail, xStrFind) > 0 Then
                xBol = False
            End If
            If xBol Then
            xStrMail = xStrMail & xStrFind
            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
            For xJ = i + 1 To xLastRow
                If CDate(xRgDate.Offset(xJ - 1).Value) - Date <= 7 And CDate(xRgDate.Offset(xJ - 1).Value) - Date > 0 Then
                    If xRgSendVal = xRgSend.Offset(xJ - 1).Value Then
                        xMailBody = xMailBody & "Text : " & xRgText.Offset(xJ - 1).Value & vbCrLf
                    End If
                End If
            Next
            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
    End If
    Next
    Set xOutApp = Nothing
End Sub
This comment was minimized by the moderator on the site
Hello, I have an additional column. 'Subject' column with different subject for each mail. How do I add the Subject Loop in the above VBA Code?
This comment was minimized by the moderator on the site
Hi Pranay,
The following code can do you a favor. Please give it a try.
Public Sub CheckAndSendMail()
'Updated by Extendoffice 20220729
    Dim xRgDate As Range
    Dim xRgSend As Range
    Dim xRgSubject 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 xRgSubject 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 xRgSubject = Application.InputBox("Please select the subject column:", "KuTools For Excel", , , , , , 8)
    If xRgSubject 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 xRgSubject = xRgSubject(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 = xRgSubject.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
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations