VBA Code to automatically send an email when a due date approaches

Hello,

First post here- having a bit of trouble working through this VBA code.
As preface to this probably really ugly code- i've been VBA coding for 2 days now haha.

My goal is to have a code scan through Column J for text saying "Send Reminder"
Then it would see if the same row's column L is Blank.
If so, it would read if the date in Column D is Less than or equal to 14 days away from today.

If all of the above was true, it would proceed to open a new Email using the following Information all from the same row as the detected "send Reminder"

Email address from Column K
Subject will be: Contract [Value from Column C] will be expiring on [Value from Column D]
Body will be: Dear [Value from Column G] please update me on the status of this contract

Afterwards, it will then mark the date the email was sent in Column L to make sure another email reminder will not be sent out.

All Desired information BEGINS on row 4, I'm hoping none of the above rows will be included.


Below is the current code I'm using - It keeps looping over the same cells sadly.

Sub TEstSend()
Dim RowCount As Long
Dim ColCount As Long
Dim tmpstr As String

For RowCount = 1 To 14
tmpstr = ""
For ColCount = 1 To 14
tmpstr = tmpstr & Cells(RowCount, ColCount)
Next ColCount
If tmpstr <> "" Then

Dim i As Long
Dim OutApp, OutMail As Object
Dim strto, strcc, strbcc, strsub, strbody As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon



For i = 3 To 10
If Cells(i, 4) - 14 < Date Then
If Cells(i, 10) = "Send Reminder" Then
Set OutMail = OutApp.CreateItem(0)
strto = Cells(i, 11).Value 'email address
strsub = "Contract " & Cells(i, 3).Value & " is expiring on " & Cells(i, 4).Value 'email subject
strbody = "Dear " & Cells(i, 7).Value & vbNewLine & "please update me on this contract's status" 'email body
With OutMail
.To = strto
.Subject = strsub
.Body = strbody
.display

On Error Resume Next
Cells(i, 12) = "Mail Sent " & Now()
Cells(i, 13) = "Reminder Sent"

End With
End If
End If
Next

Set OutMail = Nothing
Set OutApp = Nothing

End If

Next



End Sub


Thank you all!

Hi there,

See if the following code does what you need:

Please Login or Register  to view this content.

The highlighted values can be changed to suit your own requirements. Specifying the various column letters as constants at the start of the routine makes life a bit easier if the layout of your worksheet ever changes.

I would suggest combining the "Reminder Sent" and "Reminder Date" cells into a single cell containing "Reminder Sent" plus the date.


Hope this help - please let me know how you get on.

Regards,

Greg M