Hey,


I am designing a vessel maintenance tracking database that is nearing completion. One of my last things to do before deployment is creating email alerts. I have a report, RptInspectionsDue, which lists VesselName, InspectionName and DateDue. My goal is to send out a warning email when the due date is 90 days away and a critical email when the date is 30 days away. To keep Access from processing emails every time something is opened, it is best that the emails be sent out when a "Send Email Alerts" button is pressed. My boss will be the only one with that button on his front end. He'll be using the application everyday and it wont be a problem for him to hit the button at the end of each day. So I am thinking about putting a code together and throwing it in the OnClick event of the button. I had created this maintenance application MS Excel a few months ago and pasted below is the code I used for it which worked well. Just need to come up with something that caters to an Access DB. Any suggestions, improvements or help are more than welcome!


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

Set OutApp = CreateObject("Outlook.Application")

strto = "123@123.com"
strcc = "1234@1234.com"
strbcc = ""
strbody = "Attn." & vbNewLine & vbNewLine & _
"There is an engine overhaul due!" & _
vbNewLine & vbNewLine & "Automated Msg from the M/V 1234"


'Loop through rows from 1 to last row
For varRow = 3 To Sheet7.Range("A60000").End(xlUp).Row
'Check if days exceed 50
If Sheet7.Cells(varRow, 5).Value < 50 And Sheet7.Cells(varRow, 5).Value > 1 Then
strsub = "Port " & Sheet7.Cells(varRow, 1).Value & " Overhaul Coming Up!"
strbody = "Port " & Sheet7.Cells(varRow, 1).Value & " overhaul is due in " & Sheet7.Cells(varRow, 5).Value & " days"



Set OutMail = OutApp.CreateItem(0)


With OutMail
.To = strto
.CC = strcc
.Subject = strsub
.Body = strbody
.Display
End With
End If

If Sheet7.Cells(varRow, 5).Value < 0 Then
strsub = "Port " & Sheet7.Cells(varRow, 1).Value & " is Due!"
strbody = "Port " & Sheet7.Cells(varRow, 1).Value & " is due in " & Sheet7.Cells(varRow, 5).Value & " days"



Set OutMail = OutApp.CreateItem(0)


With OutMail
.To = strto
.CC = strcc
.Subject = strsub
.Body = strbody
.Display
End With
End If




If Sheet7.Cells(varRow, 8).Value < 50 And Sheet7.Cells(varRow, 8).Value > 1 Then
strsub = "Starboard " & Sheet7.Cells(varRow, 1).Value & " Overhaul Coming Up!"
strbody = "Starboard " & Sheet7.Cells(varRow, 1).Value & " overhaul is due in " & Sheet7.Cells(varRow, 8).Value & " days"



Set OutMail = OutApp.CreateItem(0)


With OutMail
.To = strto
.CC = strcc
.Subject = strsub
.Body = strbody
.Display
End With
End If

If Sheet7.Cells(varRow, 8).Value < 0 Then
strsub = "Starboard " & Sheet7.Cells(varRow, 1).Value & " is Due!"
strbody = "Starboard " & Sheet7.Cells(varRow, 1).Value & " is due in " & Sheet7.Cells(varRow, 8).Value & " days"



Set OutMail = OutApp.CreateItem(0)


With OutMail
.To = strto
.CC = strcc
.Subject = strsub
.Body = strbody
.Display
End With
End If
Next varRow

Set OutMail = Nothing
Set OutApp = Nothing
Set List = Nothing


End Sub