Loncat ke daftar isi utama

Bagaimana cara mengirim email jika tanggal jatuh tempo sudah terpenuhi di Excel?

Seperti yang ditunjukkan pada tangkapan layar di bawah, jika tanggal jatuh tempo di kolom C kurang dari atau sama dengan 7 hari (misalnya, tanggal saat ini adalah 2017/9/13), email dikirim ke penerima yang ditentukan di kolom A dan konten tertentu di kolom B ditampilkan di badan email. Bagaimana Anda bisa melakukannya untuk mencapainya? Artikel ini menyediakan kode VBA untuk membantu Anda menyelesaikan tugas ini.

Kirim email jika tanggal jatuh tempo sudah terpenuhi dengan kode VBA


Kirim email jika tanggal jatuh tempo sudah terpenuhi dengan kode VBA

Harap lakukan hal berikut untuk mengirim pengingat email jika tanggal jatuh tempo telah terpenuhi di Excel.

1. tekan lain + F11 tombol secara bersamaan untuk membuka Microsoft Visual Basic untuk Aplikasi jendela.

2. Dalam Microsoft Visual Basic untuk Aplikasi jendela, silakan klik Menyisipkan > Modul. Kemudian salin dan tempel kode VBA di bawah ini ke jendela Modul.

Kode VBA: Kirim email jika tanggal jatuh tempo ditutup di 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

Catatan: Garis Jika CDate (xRgDateVal) - Tanggal <= 7 Dan CDate (xRgDateVal) - Tanggal> 0 Kemudian dalam kode VBA artinya tanggal jatuh tempo harus lebih besar dari 1 hari dan kurang dari atau sama dengan 7 hari. Anda dapat mengubahnya sesuai kebutuhan.

3. tekan itu F5 kunci untuk menjalankan kode. Dalam bermunculan pertama Kutools untuk Excel kotak dialog, pilih rentang kolom tanggal jatuh tempo dan kemudian klik OK tombol. Lihat tangkapan layar:

4. Lalu yang kedua Kutools untuk Excel kotak dialog muncul, pilih kisaran kolom yang sesuai yang berisi alamat email penerima, dan klik OK tombol. Lihat tangkapan layar:

5. Terakhir Kutools untuk Excel kotak dialog, pilih konten yang ingin Anda tampilkan di badan email, lalu klik OK .

Kemudian email akan dibuat secara otomatis dengan penerima, subjek dan isi yang ditentukan tercantum jika tanggal jatuh tempo di kolom C kurang dari atau sama dengan 7 hari. Silakan klik Kirim tombol untuk mengirim email.

Catatan:

1. Setiap email yang dibuat sesuai dengan tanggal jatuh tempo. Misalnya, jika ada tiga tanggal jatuh tempo yang memenuhi kriteria, tiga pesan email akan dibuat secara otomatis.

2. Kode ini tidak akan dipicu jika tidak ada tanggal yang memenuhi kriteria.

3. Kode VBA hanya berfungsi saat Anda menggunakan Outlook sebagai program email Anda.


Artikel terkait:

Alat Produktivitas Kantor Terbaik

馃 Kutools AI Ajudan: Merevolusi analisis data berdasarkan: Eksekusi Cerdas   |  Hasilkan Kode  |  Buat Rumus Khusus  |  Analisis Data dan Hasilkan Grafik  |  Aktifkan Fungsi Kutools...
Fitur Populer: Temukan, Sorot, atau Identifikasi Duplikat   |  Hapus Baris Kosong   |  Gabungkan Kolom atau Sel tanpa Kehilangan Data   |   Putaran tanpa Formula ...
Pencarian Super: VLookup Beberapa Kriteria    VLookup Nilai Berganda  |   VLookup di Beberapa Lembar   |   Pencarian Fuzzy ....
Daftar Drop-down Lanjutan: Buat Daftar Drop Down dengan Cepat   |  Daftar Drop Down yang Bergantung   |  Multi-pilih Drop Down List ....
Manajer Kolom: Tambahkan Jumlah Kolom Tertentu  |  Pindahkan Kolom  |  Alihkan Status Visibilitas Kolom Tersembunyi  |  Bandingkan Rentang & Kolom ...
Fitur Unggulan: Fokus Kisi   |  Tampilan Desain   |   Bar Formula Besar    Manajer Buku Kerja & Lembar   |  Perpustakaan Sumberdaya (Teks otomatis)   |  Pemetik tanggal   |  Gabungkan Lembar Kerja   |  Enkripsi/Dekripsi Sel    Kirim Email berdasarkan Daftar   |  Filter Super   |   Filter Khusus (filter tebal/miring/coret...) ...
15 Perangkat Teratas12 Teks Tools (Tambahkan Teks, Hapus Karakter, ...)   |   50 + Grafik jenis (Gantt Chart, ...)   |   40+ Praktis Rumus (Hitung usia berdasarkan ulang tahun, ...)   |   19 Insersi Tools (Masukkan Kode QR, Sisipkan Gambar dari Jalur, ...)   |   12 Konversi Tools (Angka ke Kata, Konversi Mata Uang, ...)   |   7 Gabungkan & Pisahkan Tools (Lanjutan Gabungkan Baris, Pisahkan Sel, ...)   |   ... dan banyak lagi

Tingkatkan Keterampilan Excel Anda dengan Kutools for Excel, dan Rasakan Efisiensi yang Belum Pernah Ada Sebelumnya. Kutools for Excel Menawarkan Lebih dari 300 Fitur Lanjutan untuk Meningkatkan Produktivitas dan Menghemat Waktu.  Klik Di Sini untuk Mendapatkan Fitur yang Paling Anda Butuhkan...

Deskripsi Produk


Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
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