send Reminder Email to Outlook if cell value reached

**sathishsusa** · 06-02-2017, 03:59 PM

Hi,

i need to send reminder email to outlook automatically if due date reaches before 30 days and 15 days in expiry date column " F & K" .

Each employee having two cards if any one cards expiry then send reminder email to the employee and cc to others and date of email send to be register in column "H, I, M, N" of 15 and 30 days. please refer the attachment for more information.

The cross posted link: https://www.excelforum.com/excel-pro...ml#post4666844

Mr.SyracuseWolvrine his given the code to solve the problems but its only working by separate of 15 and 30 days. Now i need to modify the code into one module to send email to client and once email has been register in column "H, I, M, N". i don't need to send email again to client.

i don't have any knowledge about the HTML tag Code to get the color on table in outlook.

please my urge request to solve this problems.

Code:

Sub Check15SendEmail()
Dim date15 As Date
Dim toName As String
Dim toEmail As String
Dim dCardIssueDate As Date
Dim dCardExprDate As Date
Dim dCardStatus As String
Dim appOutlook As Object
Dim MailItem As Object
Dim mailbodytext As String
Dim ccEmail As String
Dim idnum As String
Dim dept As String
Dim rownum As Integer


date15 = Sheets("Sheet1").Range("Q5").Value

'Scroll through all rows and do the email process if they are near expiration
' rownum starts at 5 because that is the first row with data
' I chose to end it at 7 as this is the last row with all data
For rownum = 5 To 50

'check to see if date is within 15 days

If Sheets("Sheet1").Range("F" & rownum) < date15 Then

'If Sheets("Sheet1").Range("F" & rownum) < date15 Then

    'if so, do the email
toName = Sheets("Sheet1").Range("A" & rownum).Value
toEmail = Sheets("Sheet1").Range("C" & rownum).Value
idnum = Sheets("Sheet1").Range("B" & rownum).Value
dept = Sheets("Sheet1").Range("D" & rownum).Value
dCardIssueDate = Sheets("Sheet1").Range("E" & rownum).Value
dCardExprDate = Sheets("Sheet1").Range("F" & rownum).Value
dCardStatus = Sheets("Sheet1").Range("G" & rownum).Value

mybodytext = "<p>Dear " & toName & ",<br />"
mybodytext = mybodytext & "<br />This is to remind you that your card is going to be expiring soon. Kindly arrange to renew your card as soon as possible.<br />"
mybodytext = mybodytext & "<table border=""1""><tr><td>Name</td><td>ID No</td><td>Email ID</td><td>Department</td><td>Driving Card Issue Date</td><td>Driving Card Expiry Date</td><td>Status</td></tr>"
mybodytext = mybodytext & "<tr><td>" & toName & "</td><td>" & idnum & "</td><td>" & toEmail & "</td><td>" & dept & "</td><td>" & dCardIssueDate & "</td><td>" & dCardExprDate & "</td><td>" & dCardStatus & "</td></tr>"
mybodytext = mybodytext & "</table><br />Regards,"

Set appOutlook = GetObject(, "Outlook.Application")
Set MailItem = appOutlook.CreateItem(0)

MailItem.htmlbody = mybodytext
MailItem.To = toEmail
MailItem.Subject = "Your Driving Card Expiry Date is less than 15 days"
MailItem.Display


Sheets("Sheet1").Range("I" & rownum).Value = Now()

End If

Next rownum

Set appOutlook = Nothing
Set MailItem = Nothing

End Sub

Sub Check30SendEmail()
Dim date30 As Date
Dim toName As String
Dim toEmail As String
Dim dCardIssueDate As Date
Dim dCardExprDate As Date
Dim dCardStatus As String
Dim appOutlook As Object
Dim MailItem As Object
Dim mailbodytext As String
Dim ccEmail As String
Dim idnum As String
Dim dept As String
Dim rownum As Integer


date30 = Sheets("Sheet1").Range("Q6").Value

'Scroll through all rows and do the email process if they are near expiration
' rownum starts at 5 because that is the first row with data
' I chose to end it at 7 as this is the last row with all data
For rownum = 5 To 50

'check to see if date is within 15 days

If Sheets("Sheet1").Range("F" & rownum) < date30 Then

    'if so, do the email
toName = Sheets("Sheet1").Range("A" & rownum).Value
toEmail = Sheets("Sheet1").Range("C" & rownum).Value
idnum = Sheets("Sheet1").Range("B" & rownum).Value
dept = Sheets("Sheet1").Range("D" & rownum).Value
dCardIssueDate = Sheets("Sheet1").Range("E" & rownum).Value
dCardExprDate = Sheets("Sheet1").Range("F" & rownum).Value
dCardStatus = Sheets("Sheet1").Range("G" & rownum).Value

mybodytext = "<p>Dear " & toName & ",<br />"
mybodytext = mybodytext & "<br />This is to remind you that your card is going to be expiring soon. Kindly arrange to renew your card as soon as possible.<br />"
mybodytext = mybodytext & "<table border=""1""><tr><td>Name</td><td>ID No</td><td>Email ID</td><td>Department</td><td>Driving Card Issue Date</td><td>Driving Card Expiry Date</td><td>Status</td></tr>"
mybodytext = mybodytext & "<tr><td>" & toName & "</td><td>" & idnum & "</td><td>" & toEmail & "</td><td>" & dept & "</td><td>" & dCardIssueDate & "</td><td>" & dCardExprDate & "</td><td>" & dCardStatus & "</td></tr>"
mybodytext = mybodytext & "</table><br />Regards,"

Set appOutlook = GetObject(, "Outlook.Application")
Set MailItem = appOutlook.CreateItem(0)

MailItem.htmlbody = mybodytext
MailItem.To = toEmail
MailItem.Subject = "Your Driving Card Expiry Date is less than 30 days"
MailItem.Display


Sheets("Sheet1").Range("H" & rownum).Value = Now()

End If

Next rownum

Set appOutlook = Nothing
Set MailItem = Nothing

End Sub

**Admin** · 06-04-2017, 12:30 PM

Hi

Please find attached.

**sathishsusa** · 06-04-2017, 03:45 PM

Dear Admin,

wow, once again many thanks for replying and solving the problems i little change your code as my requirement and its working fine. i need few more help from you before closing this thread.
1. If possible i can get the Bgcolor(background color) on table in outlook mail any color because i don't have any knowledge in HTML Tag code how to create bg color.
2. How can i set this module when workbook is open to send the mail notification.
3.How to add the cc email id which is in Email List worksheet

Please help on this would be much appreciated!

**dora** · 06-10-2017, 07:54 PM

Hi Team,

I have a similar requirement where i need to send status for employees about their training status.
A file having resources and their pending training status.

we should print the status for each resource and send the mail as a reminder for each resource in the given range.

Have attached excel file for your reference and the final output mail picture as an output

Appreciate your help and support.

**sathishsusa** · 06-10-2017, 08:36 PM

Hi dora ,

Please start with New thread as your requirement and to explain what criteria, when meets you need to send email then someone can help you.

**Admin** · 06-12-2017, 08:35 AM

Originally Posted by sathishsusa

Dear Admin,

wow, once again many thanks for replying and solving the problems i little change your code as my requirement and its working fine. i need few more help from you before closing this thread.
1. If possible i can get the Bgcolor(background color) on table in outlook mail any color because i don't have any knowledge in HTML Tag code how to create bg color.
2. How can i set this module when workbook is open to send the mail notification.
3.How to add the cc email id which is in Email List worksheet

Please help on this would be much appreciated!

Have a look at this page.

https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

**sathishsusa** · 06-12-2017, 07:44 PM

Thank you so much admin

**TonyBer** · 07-17-2017, 02:48 PM

Originally Posted by Admin

Hi dora ,

Please tell everyone more about phenq and start with New thread as your requirement and to explain what criteria, when meets you need to send email then someone can help you.

That's very helpful, thanks very much.