Get excel 2010 to send auto e-mail

[Closed]
Report
Posts
1
Registration date
Tuesday April 16, 2013
Status
Member
Last seen
April 16, 2013
-
Posts
2817
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 14, 2021
-
Hello,

I have a spreadsheet that i track my vendors certificate of insuranse expiration dates on. i am wanting excel to send me an automatic e-mail when a formula cell i have created that tells me their COI expires in less than 30 days turn to "YES". I have got this to work in the past, but it would send duplicate e-mails on vendors that it sent the day before. i only want it to send me ones that have just changed. the formula i used before got erased somehow. below you will see what columns i have what in. I have a column with the e-mail address i want the e-mail sent to. in the e-mail i would like the subject to say "COI ABOUT TO EXPIRE". In the body i would like it to say "(Vendor Name in Column A) COI will expire in less than 30 days. Please contact them using (e-mail address is Column AU) or (Phone number in Column AV) to get an updated copy."

Column info:

Column A-Vendor Name
Column AO- Expiration Date
Column AP- formula working off of Column AO information telling me if it expires in less than 30 days.
Column AQ-Email address i would like the e-mail sent to.
Column AU-Vendor e-mail adress i would like in the e-mail body
Column AV- Vendor phone number i would like in the e-mail body






Below is the formula i am trying to use but i will not work:


Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Dim EMS As Range
Dim lastRow As Long
Dim dateCell, dateCell1 As Date

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
lastRow = Range("A" & Rows.Count).End(xlUp).Row
On Error GoTo cleanup
For Each EMS In Range("AP4:AP" & lastRow)
If EMS = "YES" Then
dateCell = EMS.Value
dateCell1 = Cells(EMS.Row, "AP").Value
If dateCell <> dateCell1 Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Cells(EMS.Row, "AQ").Value
.Subject = "COI ABOIT TO EXPIRE"
.Body = "VENDOR " & Cells(EMS.Row, "A").Value _
& vbNewLine & vbNewLine & _
"COI EXPIRES IN 30 DAYS OR LESS PLEASE CONTACT THEM TO RENEW " & Cells(EMS.Row, "AU,AV").Value & _
vbNewLine & vbNewLine _
& vbNewLine & vbNewLine & _
"THANKS," & vbNewLine & _
"MSA LIST"
.send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Cells(EMS.Row, "AP").Value = "NO"
EMS.ClearContents
End With
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


Please Help
Thanks

1 reply

Posts
2817
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
October 14, 2021
486
Hi Eturner,

Did you write the code yourself?

A few things I noticed.

In the code:
On Error GoTo cleanup *you never specified cleanup

For Each EMS In Range("AP4:AP" & lastRow)
If EMS = "YES" Then
dateCell = EMS.Value *Which is YES.
dateCell1 = Cells(EMS.Row, "AP").Value *Same row, same column.
If dateCell <> dateCell1 Then *Comparing 2 values at the same location will always be the same.

Cells(EMS.Row, "AP").Value = "NO" *First you change value to NO.
EMS.ClearContents *And then you clear the cell of it's contents.

For Each EMS without Next EMS
You got 1x With and 2x End With.
You got 2x If and 1x End IF.

I don't have Outlook installed, so i can't test the functionality.

Hopefully I have helped a little.

Best regards,
Trowa