Send mail when deadline expires
 

Dear excel(lent) users,

I have a worksheet in which I keep action points. These action points can
expire according to the deadline (when today is bigger than the deadline). Is
it possible to use a macro to send me a mail when the deadline becomes
smaller than today (more people are using this file and I want to stay in
touch with the deadlines). I used :

Private Sub Worksheet_Change2(ByVal Target As Range)
Dim rng As Range
If Target.Cells.Count 1 Then Exit Sub
On Error GoTo EndMacro
If Not Target.HasFormula Then
Set rng3 = Range("I:I")
If Not Intersect(Range("I"), rng3) Is Nothing Then
If Range("I:I").Value < Now() Then SendMail
End If
End If
EndMacro:
End Sub
Sub SendMail()
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")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strto = "
strcc = ""
strbcc = ""
strsub = "Important message"
strbody = "Hi there" & vbNewLine & vbNewLine & _
"A new deadline has passed"

With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
.Send
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

What am I doing wrong?