How to send an email from excel when a condition is met

July 31, 2020 at 00:32:35
Specs: Windows
I want to be able to send an email to myself when one condition is met.
the condition is when the days remaining on a policy reaches 60 days, it will automatically send an email to me alerting to me that the policy is expiring in 60 days.

I know its possible but I am new to coding & VBA and any help would be much appreciated!

message edited by pingpongmutaa

See More: How to send an email from excel when a condition is met

July 31, 2020 at 07:56:21
Question has been asked and answered several times, here are a couple:

As you can see, some of it will depend on what your sheet looks like.
Also, for future reference, Excel questions are best asked in the Office Software forum.


message edited by mmcconaghy

Reply ↓  Report •

August 2, 2020 at 21:02:47
More specifically :

Column A Column B Column C Column D Column E Column F

Company Expiry Date Days to Expiry Status
A 3/08/20
B 3/11/20
C 3/12/20

I need coding to automatically refresh 'days to expiry' from the current day & the status from 0 being expired, <=60 to be about to expire and >60 on time

This is important because its not just basic coding I need, its more than that. I want to be able keep to automatically open the sheet, check column C to see how many Companies will have their policy expiring within 60 days and send an email to me notifying me that the policy is expiring in 60 days.

I have also tried to set a timer every 24 hours to refresh and send an email with a 60 day expiry date. However I tried testing it every one minute and received 300+ emails within 1 minute!

I can also see that I receive 2 emails for two companies which are about to expire, e.g. I receive one email for one company then I receive another email with has 2 companies expiring. I want to be able to receive one email with a list of expiring dates AND not repeating the same process after 24 hours. Just send one email once it hits 60 days.

Here, I have tried to use this:

Module 1

Dim uRange
Dim lRange
Dim BCell As Range
Dim EmailString As String

Public Sub GetExpirations()

Set uRange = Sheet1.Range("D2")
Set lRange = Sheet1.Range("D" & Rows.Count).End(xlUp)
EmailString = Empty

For Each DCell In Range(uRange, lRange)

If DCell <= 60 Then

EmailString = EmailString & DCell.Offset(0, -2) & " policy is due to expire in 60 days. This is an automated email response to update the policy within expiry." & vbCrLf
SendMail EmailString

End If

End Sub

Sub SendMail(iBody As String)

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'If ActiveWorkbook.Saved = True Then

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = iBody

On Error Resume Next
With OutMail
.To = "example"
.CC = ""
.BCC = ""
.Subject = "A policy is about to expire soon"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

'End If
End Sub

Sheet 1:

Dim StopTimer As Boolean
Dim SchdTime As Date
Dim Etime As Date
Const OneSec As Date = 1 / 86400#

Private Sub ResetBtn_Click()
StopTimer = True
Etime = 0
Sheet2.Range("B3").Value = "00:00:00"
End Sub

Private Sub StartBtn_Click()
StopTimer = False
SchdTime = Now()
Sheet2.Range("B3").Value = Format(Etime, "hh:mm:ss")
Application.OnTime SchdTime + OneMin, "Sheet1.NextTick"
End Sub

Private Sub StopBtn_Click()
StopTimer = True
End Sub

Sub NextTick()
If StopTimer Then
'Don't reschedule update

If Sheet2.Range("B3").Text >= "01:00:00" Then
Debug.Print Now()
End If

Sheet2.Range("B3").Value = Format(Etime, "hh:mm:ss")
SchdTime = SchdTime + OneMin
Application.OnTime SchdTime, "Sheet1.NextTick"
Etime = Etime + OneMin

End If
End Sub

I am also a bit unsure about the timer I have put in on sheet2 cell B3. I don't know how to format it. Is it just '=now()' or more for the Macro to read it.

Reply ↓  Report •
Related Solutions

Ask Question