sathishsusa
Member
Hi,
i want to send reminder email to client via outlook if due date is reaching before 30 and 15 days.
once mail send to the client then date to be registered in column "H, I" of 15 and 30 days.
The code which is working by separate module of 15 and 30 days working fine and i tried to make in one module but i became failure. please can anyone help me to modify the code into one module to send the email once workbook is open. i am waiting for long time to solve this problems but i didn't get no any positive results. please my humble request any help at all would be much appreciated!
Thanks for looking and for your time. if any further additional details need on this file please let me know i will provide you sir.
i want to send reminder email to client via outlook if due date is reaching before 30 and 15 days.
once mail send to the client then date to be registered in column "H, I" of 15 and 30 days.
The code which is working by separate module of 15 and 30 days working fine and i tried to make in one module but i became failure. please can anyone help me to modify the code into one module to send the email once workbook is open. i am waiting for long time to solve this problems but i didn't get no any positive results. please my humble request any help at all would be much appreciated!
Thanks for looking and for your time. if any further additional details need on this file please let me know i will provide you sir.
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 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