Automatically Generate Reminder E-mail Based on Date

[Justinian]

I have a spreadsheet for preventative maintenance items. These items are to occur one a year so if an inspection happens 1/21/20, the next inspection should occur 1/21/21. I also have conditional formatting so that the row containing the maintenance item is highlighted when today's date is within thirty (30) days of the due date. So on 12/21/20, the row with this item will highlight, reminding me that an inspection is due by 1/21/21.

My question is how can I get Excel is automatically generate an e-mail when the conditional formatting highlights this row? Or how can I get Excel to generate an e-mail when an item is within thirty (30) days of its inspection date? So any date between 12/21/20 and 1/20/21 will generate a reminder to do this inspection.

 

[Logit]

Option Explicit

Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp
Dim OutMail

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

Sheets(1).Select
lRow = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lRow
toDate = Sheets("Sheet1").Cells(i, 1)

If toDate < Date Then: Exit Sub

  If Left(Cells(i, 5), 4) <> "Mail" And toDate = Date Then
 
             Set OutApp = CreateObject("Outlook.Application")
             Set OutMail = OutApp.CreateItem(0)
        
                toList = Cells(i, 2)    'gets the recipient from col B
                eSubject = Cells(i, 3)  'gets subject from col C
                eBody = Cells(i, 4)     'gets body of email from col D
                
                'enter email body here
                
                On Error Resume Next
                With OutMail
                .To = toList
                .CC = ""
                .BCC = ""
                .Subject = eSubject
                .Body = eBody
                .bodyformat = 1
                .Display   ' ********* Creates draft emails. Comment this out when you are ready
                '.Send     '********** UN-comment this when you  are ready to go live
                End With
        
            On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing
         Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column C"
            
    End If
Next i
ActiveWorkbook.Save

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
MsgBox "All emails have been sent. ", vbInformation, "Email Notice "

End Sub

Sub sbInsertingRows()
    'Inserting a Row at at Row 2
    Range("A2").EntireRow.Insert
End Sub

Sub sbInsertingRows()
'Inserting a Row at at Row 2
Range("A2").EntireRow.Insert
End Sub

Option Explicit

Private Sub Workbook_Open()
    eMail
End Sub

 

[Justinian]

Why the "add second row" macro?

I tried your first code (Option Explicit) and when I ran the macro, nothing happened.

 

[Logit]

" Why the "add second row" macro? "
For convenience ... it inserts a new row at A2 for addition of a new entry. As indicated in the image, newest dates must always be above older dates.

" I tried your first code (Option Explicit) and when I ran the macro, nothing happened. "
Did you include the following short sub in ThisWorkbook module ? :

Option Explicit

Private Sub Workbook_Open()
    eMail
End Sub

Enter todays date in A2. Save the workbook ... close it ... then re-open it. The email should be auto-created.

The project runs fine here.

 

[Justinian]

I am not adding any new rows, just sticking to my initial eighteen (row 4-21).

It is working now but only when I hit Alt+F8 ad run the macro.

 

[Logit]

Edit this line in the code :

For i = 2 To lRow .................. change it to ...................... For i = 4 To lRow

If you decide in the future to start your list of dates on row #2, change the above line back to the original. Edit the line to correspond to the row
your list begins.

If you create a Command Button on the sheet, and connect it to the Email macro, you will be able to run the macro without the need for ALT - F8 (see image above).

If you enter today's date in A4 and have the macro (shown in Post #4) located in the ThisWorkBook module, when you open the workbook, the email will generate
automatically.

If any of the the preceding does not work for you there, it is due to user error.

 

[Justinian]

Ok, I understand now.

One last question: in the following line of code, which will be inserted into the email that your code opens, how do I format these words in bold?

Words to bold:
- "Tower"
- "Last Tuning Date"
- "Tuning Deadline Date"

Code:
vbLf & vbLf & "Tower: " & vbLf & "Last Tuning Date: " & vbLf & "Tuning Deadline Date: " & vbLf & _

 

[Logit]

Where in all of the code, are you inserting that line ?

 

[Justinian]

I modified the e-mail code to conform to what my boss wants to see but the line of code is below:

Sub Tony_Henry_Email()

' Send e-mail to Tony
Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail
.To = "john.smith@aol.com"
.Subject = "Tower Boiler Tuning Reminder"
.Body = "John," & vbLf & vbLf & "A tower boiler tuning reminder alert has been triggered for the following tower:" & _
vbLf & vbLf & "Tower: " & vbLf & "Last Tuning Date: " & vbLf & "Tuning Deadline Date: " & vbLf & _
.Display ' Use .Send to skip e-mail display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

 

[Logit]

.Body = "John," & vbCrLf & vbCrLf & "A tower boiler tuning reminder alert has been triggered for the following tower:" & _
[B]vbCrLf & vbCrLf & "Tower: " & vbCrLf & "Last Tuning Date: " & vbCrLf & "Tuning Deadline Date: " & vbCrLf & _[/B]

Note the use of vbCrLf

I have not tested the macro here.