VBA to send email based on cells' value to recipients in excel sheet and include cell's value in the email's body

Eraclis

New Member
Joined
Feb 23, 2021
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
Hello Everyone!

I hope you are all healthy and safe!

I wrote a VBA so that Excel will send out email if the value in a cells range changes (days countdown). The VBA write-up works just fine! However, I need to take it a step further! Eventually, I would like my VBA to do the below additions:
1) Send the email to the email address included in the spreadsheet (next to the cells counting the days); and
2) Include the client's name into the email's body.

I looked online for a solution since my VBA write up skills are not that good yet, but my experience with MrExcel showed me that there are Excel Gurus here who can help!!

I am uploading below a sample sheet to assist on explaining what I am aiming to do, as well as the current VBA written up!

Currently:
Excel sends out email to specific recipients (refer to my write up below) when "CALENDAR DAYS" (Column L) reach 31.

Eventually:
Excel should
1) send out email when "CALENDAR DAYS" reach 31;
2) to the email addresses listed under "OFFICERS (EMAIL)" (Column K); and
3) include in the email's body (apart from the standard wording I wrote) the value of the cell under "CUSTOMER NAME" (Column C).

SAMPLE:
A
B
C
D
E
F
G
H
I
J
K
L
CUSTOMER No.CUSTOMER NAMEUNITACTION No.AREAHEARING DATE
(DD/MM/YYYY)
LAW FIRMLM OFFICERHANDLING OFFICERSOFFICERS (EMAIL)CALENDAR DAYS
112345678ABCCORPORATE123Area 110/05/2021Lawyer 1LM Officer 1Officer 1Officer1@testmail.net12
212345679DEFRETAIL456Area 210/07/2021Lawyer 2LM Officer 2Officer 2Officer2@testmail.net73
312345680GHIRETAIL789Area 310/09/2021Lawyer 3LM Officer 3Officer 3Officer3@testmail.net135
412345681JKLCORPORATE101Area 410/10/2021Lawyer 4LM Officer 4Officer 4Officer4@testmail.net165
512345682MNOCORPORATE112Area 510/11/2021Lawyer 5LM Officer 5Officer 5Officer5@testmail.net196
612345683PQRCORPORATE131Area 611/11/2021Lawyer 6LM Officer 6Officer 6Officer6@testmail.net197
712345684STUCORPORATE415Area 711/12/2021Lawyer 7LM Officer 7Officer 7Officer7@testmail.net227
812345685VWXCORPORATE161Area 811/01/2022Lawyer 8LM Officer 8Officer 8Officer8@testmail.net258
912345686YZARETAIL718Area 911/02/2022Lawyer 9LM Officer 9Officer 9Officer9@testmail.net289
1012345687BCDRETAIL192Area 1012/03/2022Lawyer 10LM Officer 10Officer 10Officer10@testmail.net318

VBA Write up:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("L:L"), Target) Is Nothing Then
If IsNumeric(Target.Value) And Target.Value = 31 Then
Call Mail_small_Text_Outlook
End If
End If
End Sub
________________________________________________________________________________________________________________________________________________________________________________________________________________________________________________
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Hi there," & vbNewLine & vbNewLine & _
"According to the information included in the Tracker designed by the Department, you have a client case approaching. Please check the Tracker for scheduling a coordination meeting." & vbNewLine & _
"Thank you in advance." & vbNewLine & _
"" & vbNewLine & _
"Kind regards," & vbNewLine & _
"The Department"

On Error Resume Next
With OutMail
.To = "samplemail1@test.net;samplemail2@test.net"
.CC = ""
.BCC = ""
.Subject = "AUTOMATED EMAIL SENT FROM EXCEL"
.Body = strbody
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Thank you in advance!

Kind regards,
Eraclis
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Forum statistics

Threads
1,143,842
Messages
5,721,119
Members
422,340
Latest member
canadianbacon357

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top