I was informed to make this as descriptive as possible, hopefully I have accomplished that. If I have made an error in how I have posted this, I apologize in advance.
We need a spreadsheet that can auto send emails to individuals, one will be 1 year from their expiration date and to send another at 6 months from their expiration date (if they have not recertified by then, if so it would reset the dates). There will be 250 names in this spreadsheet.
I am using Excel 2013.
Here is how I have my columns set up:
A – Name
B – Rank (in a drop down box)
C – Unit (in a drop down box)
D – Email
E – Date Certified
F – Expiration Date (which is 5 years after certification)
G – 12 Month Reminder (365 days before expiration)
H – Email Sent
I – 6 Month Reminder (180 days before expiration)
J – Email Sent
L – (Hidden) Data for Column B
M – (Hidden) Data for Column C
Email Message that will be sent in the Macro:
(1 Yr Email) This is a reminder that your Instructor Certification will expire in 365 days. You will need to resubmit your Instructor Certification Packet to your Training NCO so they can forward your packet to BDE. If you have any questions on this action, contact your Training NCO or the BDE representative.
or
(6 Month Email) This is a second reminder that your Instructor Certification will expire. You have 180 days until it is expired. You will need to resubmit your Instructor Certification Packet to your Training NCO so they can forward your packet to BDE. If you have any questions on this action, contact your Training NCO or the BDE representative.
If the spreadsheet is on a SharePoint, will it be able to generate the email, or will I need to keep it on a computer so it has access to Outlook?
What I need the worksheet to do:
In my code, the cell values are have a temporary ? in them. I did this because the tutorial I watched showed their dates as a numerical value not a date. I have attached an image of my coding as well as placing it here:
Thanks for looking at my mess, lol.
Larry
We need a spreadsheet that can auto send emails to individuals, one will be 1 year from their expiration date and to send another at 6 months from their expiration date (if they have not recertified by then, if so it would reset the dates). There will be 250 names in this spreadsheet.
I am using Excel 2013.
Here is how I have my columns set up:
A – Name
B – Rank (in a drop down box)
C – Unit (in a drop down box)
D – Email
E – Date Certified
F – Expiration Date (which is 5 years after certification)
G – 12 Month Reminder (365 days before expiration)
H – Email Sent
I – 6 Month Reminder (180 days before expiration)
J – Email Sent
L – (Hidden) Data for Column B
M – (Hidden) Data for Column C
Email Message that will be sent in the Macro:
(1 Yr Email) This is a reminder that your Instructor Certification will expire in 365 days. You will need to resubmit your Instructor Certification Packet to your Training NCO so they can forward your packet to BDE. If you have any questions on this action, contact your Training NCO or the BDE representative.
or
(6 Month Email) This is a second reminder that your Instructor Certification will expire. You have 180 days until it is expired. You will need to resubmit your Instructor Certification Packet to your Training NCO so they can forward your packet to BDE. If you have any questions on this action, contact your Training NCO or the BDE representative.
If the spreadsheet is on a SharePoint, will it be able to generate the email, or will I need to keep it on a computer so it has access to Outlook?
What I need the worksheet to do:
- Allow the user to input data into Column A, use the drop down boxes for B and C, and input their date certified in column E. Columns F – J will not be available for user input.
- Column G will auto populate by using:
=DATE(YEAR(E2) + 5, MONTH(E2), DAY(E2)) - Column I will auto populate by using:
=DATE(YEAR(F2),MONTH(F2)-6,DAY(F2)) - Column H will be coded to send an email 12 months before the expiration date.
- If it is successful, it needs to have a fill color of green with the word GO (bold) in white in it.
- If it fails to deliver the email it needs to have a fill color of red with the words NO GO (bold) in white.
- If it is not time yet, there will be no fill and no data displayed.
- Column J will be coded to send an email 6 months before the expiration date.
- If it is successful, it needs to have a fill color of green with the word GO (bold) in white in it.
- If it fails to deliver the email it needs to have a fill color of red with the words NO GO (bold) in white.
- If it is not time yet for the email, then there will be no fill and no data displayed.
- If the Expiration Date (Column F) has expired, then that cell should turn to red.
In my code, the cell values are have a temporary ? in them. I did this because the tutorial I watched showed their dates as a numerical value not a date. I have attached an image of my coding as well as placing it here:
VBA Code:
Sub datesexcevlvba()
Dim myApp As Outlook.Application, mymail As Outlook.MailItem
Dim mydate1 As Date
Dim mydate2 As Long
Dim datetoday1 As Date
Dim datetoday2 As Long
Dim x As Long
lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To lstrow
mydate1 = Cells(x, ?).Value
maydate2 = mydate1
cells(x,?).value=mydate2
datetoday1 = Date
datetoday2 = datetoday1
Cells(x, ?).Value=datetoday2
ifmydate2-datetoday=43800 Then
Email Part
Set myApp = New Outlook.Application
Set mymail = myApp.CreateItem(olMailItem)
mymail.To = Cells(x, 4).Value
With mymail
.Subject = "12 Month Expiration Reminder"
.Body = "This is a reminder that your Instructor Certification will expire in 365 days." & vbCrLf & "You will need to resubmit your Instructor Certification Packet to your Training NCO so they can forward your packet to BDE." & vbCrLf & "If you have any questions on this action, contact your Training NCO or the BDE representative."
'.Send
End With
Cells(x, 8) = "GO"
Cells(x, 8).Interior.ColorIndex = 10
Cells(x, 8).Font.ColorIndex = 2
Cells(x, 8).Font.Bold = True
Cells(x,?).Value=mydate2 - datetoday2
End If
Set myApp = Nothing
Set mymail = Nothing
End Sub
Thanks for looking at my mess, lol.
Larry
Attachments
Last edited by a moderator: