Pick data from cell and add to e-mail script

[aliaslamy2k]

Dear Experts

Below is the e-mail script which is working very well. However, I want the e-mail script to add subject line and take data from cells

Examples :-

strsub = "Alert Vehicles number 12345 (Pick up from cell E2) License Expire in 45 (Pick up from cell J2) days, “


strbody = "Dear All" & vbNewLine & vbNewLine & _
"This is an Auto Generated E-mail" & vbNewLine & vbNewLine & _
"Kindly note that Vehicle number 12345 (Pick up from cell E2) License Expire in 45 (Pick up from cell J2) days, “ & vbNewLine & vbNewLine & _
"Kind Regards," & vbNewLine & vbNewLine & _
"Vehicle Management Team"


Expected Result

Strsub = Alert Vehicle number 12345 License Expires in 45 days

Strbody = Dear All,
This is an Auto Generated E-mail
Kindly note that Vehicle number 12345 License expires in 45 days
Kind regards,
Vehicle Management Team



Actual VBA currently in use


Private Sub Worksheet_Calculate()
Dim c As Range
Application.EnableEvents = False
For Each c In Range("J2:J12")
With c
If .Value > 1 And .Value < 45 And .Offset(0, 1) <> "E-MAIL SENT" Then
Call Semail1
.Offset(0, 1).Value = "E-MAIL SENT"
End If
If .Value > 44 Then .Offset(0, 1).ClearContents
End With
Next c
Application.EnableEvents = True
End Sub





Sub Semail1()

Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Application.EnableEvents = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strto = "alia@something.com"
strcc = ""
strbcc = ""
strsub = "Vehicles License Expiry Alert, "
strbody = "Dear All" & vbNewLine & vbNewLine & _
"This is an Auto Generated E-mail" & vbNewLine & vbNewLine & _
"Kindly note that one or more vehicle license/s will be expiring within 45 Days, please start planning accordingly" & vbNewLine & vbNewLine & _
"Kind Regards," & vbNewLine & vbNewLine & _
"Vehicle Management Team"
With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
.Display
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
End With
Application.EnableEvents = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

ALI - EMAIL TESTING 18MAR20.xlsm
	E	F	G	H	I	J	K
1	Vehicle #	Owner	User Company	Vehicle Brand	QID EXPIRY DATE	Days to expire	Status
2	12345	AA	AAA	Toyota	15-Apr-2020	28	E-MAIL SENT
3	6789	BB	BBB	Kia	26-Mar-2022	738
4	101112	CC	CCC	Mitsubishi	30-Jul-2019	LIC EXPIRED
5	131415	DD	DDD	Toyota	13-Apr-2019	LIC EXPIRED
6	161718	EE	EEE	Kia	28-Dec-2020	285
7	192021	FF	FFF	Mitsubishi	24-Mar-2020	6	E-MAIL SENT
8	222324	GG	GGG	Toyota	16-Sep-2020	182
9	252627	HH	HHH	Kia	18-Jul-2020	122
10	282930	II	III	Mitsubishi	18-Mar-2020	0
11	313233	JJ	JJJ	Toyota	7-Apr-2020	20	E-MAIL SENT
12	343536	KK	KKK	Kia	7-Dec-2019	LIC EXPIRED
Sheet1

 

[DanteAmor]

Try this

Private Sub Worksheet_Calculate()
  Dim c As Range
  Application.EnableEvents = False
  For Each c In Range("J2:J12")
    With c
      If .Value > 1 And .Value < 45 And .Offset(0, 1) <> "E-MAIL SENT" Then
        Call Semail1(c.Row)
        .Offset(0, 1).Value = "E-MAIL SENT"
      End If
      If .Value > 44 Then .Offset(0, 1).ClearContents
    End With
  Next c
  Application.EnableEvents = True
End Sub

Sub Semail1(i As Long)
  Dim OutApp As Object
  Dim OutMail As Object
  Dim strto As String, strcc As String, strbcc As String
  Dim strsub As String, strbody As String
  Application.EnableEvents = False
  Set OutApp = CreateObject("Outlook.Application")
  OutApp.Session.Logon
  Set OutMail = OutApp.CreateItem(0)
  
  strto = "alia@something.com"
  strcc = ""
  strbcc = ""
  strsub = "Alert Vehicles number " & Range("E" & i) & " License Expire in " & Range("J" & i) & " days, "
  strbody = "Dear All" & vbNewLine & vbNewLine & _
    "This is an Auto Generated E-mail" & vbNewLine & vbNewLine & _
    "Kindly note that Vehicle number " & Range("E" & i) & " License Expire in " & Range("J" & i) & " days, " & vbNewLine & vbNewLine & _
    "Kind Regards," & vbNewLine & vbNewLine & _
    "Vehicle Management Team"
  With OutMail
    .To = strto
    .CC = strcc
    .BCC = strbcc
    .Subject = strsub
    .Body = strbody
    .Display
    Application.Wait (Now + TimeValue("0:00:02"))
    Application.SendKeys "%s"
  End With
  Application.EnableEvents = True
  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub

 

[aliaslamy2k]

Try this

Private Sub Worksheet_Calculate()
  Dim c As Range
  Application.EnableEvents = False
  For Each c In Range("J2:J12")
    With c
      If .Value > 1 And .Value < 45 And .Offset(0, 1) <> "E-MAIL SENT" Then
        Call Semail1(c.Row)
        .Offset(0, 1).Value = "E-MAIL SENT"
      End If
      If .Value > 44 Then .Offset(0, 1).ClearContents
    End With
  Next c
  Application.EnableEvents = True
End Sub

Sub Semail1(i As Long)
  Dim OutApp As Object
  Dim OutMail As Object
  Dim strto As String, strcc As String, strbcc As String
  Dim strsub As String, strbody As String
  Application.EnableEvents = False
  Set OutApp = CreateObject("Outlook.Application")
  OutApp.Session.Logon
  Set OutMail = OutApp.CreateItem(0)
 
  strto = "alia@something.com"
  strcc = ""
  strbcc = ""
  strsub = "Alert Vehicles number " & Range("E" & i) & " License Expire in " & Range("J" & i) & " days, "
  strbody = "Dear All" & vbNewLine & vbNewLine & _
    "This is an Auto Generated E-mail" & vbNewLine & vbNewLine & _
    "Kindly note that Vehicle number " & Range("E" & i) & " License Expire in " & Range("J" & i) & " days, " & vbNewLine & vbNewLine & _
    "Kind Regards," & vbNewLine & vbNewLine & _
    "Vehicle Management Team"
  With OutMail
    .To = strto
    .CC = strcc
    .BCC = strbcc
    .Subject = strsub
    .Body = strbody
    .Display
    Application.Wait (Now + TimeValue("0:00:02"))
    Application.SendKeys "%s"
  End With
  Application.EnableEvents = True
  Set OutMail = Nothing
  Set OutApp = Nothing
End Sub

Hi DanteAmor,

This code is Perfect !!!

Thanks a million for this wonderful code. It works exactly as expected.

Thank you once again .

Regards,

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.