Option Explicit
Private Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Date
NotSentMsg = "Not Sent"
SentMsg = "Sent"
'Above the MyLimit value it will run the macro
MyLimit = Date //Set The Current Date
'Set the range with Formulas that you want to check
Set FormulaRange = Me.Range("J6:J60") //Date Range
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
If IsDate(.Value) = False Then
MyMsg = "Not a date"
Else
If .Value < MyLimit Then
MyMsg = SentMsg
If .Offset(0, 1).Value = NotSentMsg Then
Call Mail_with_outlook2 //Call To Send Emails
End If
Else
MyMsg = NotSentMsg
End If
End If
Application.EnableEvents = False
.Offset(0, 1).Value = MyMsg
Application.EnableEvents = True
End With
Next FormulaCell
ExitMacro:
Exit Sub
EndMacro:
Application.EnableEvents = True
MsgBox "Some Error occurred." _
& vbLf & Err.Number _
& vbLf & Err.Description
End Sub
=================================================
Email Sending Part
=================================================
Sub Mail_with_outlook2()
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")
Set OutMail = OutApp.CreateItem(0)
strto = Cells(FormulaCell.Row, "P").Value
strcc = ""
strbcc = ""
strsub = "Do an update"
strbody = "Hi " & Cells(FormulaCell.Row, "L").Value & vbNewLine & vbNewLine & _
"Your expiry date is: " & Cells(FormulaCell.Row, "J").Value & vbNewLine & _
"for the task of : " & Cells(FormulaCell.Row, "C").Value & _
vbNewLine & vbNewLine & "Do an update" & _
vbNewLine & vbNewLine & "Thanks." & _
vbNewLine & vbNewLine & "Regards," & _
vbNewLine & vbNewLine & "Marina Samaratunge"
With OutMail
.To = strto
.CC = strcc
.BCC = strbcc
.Subject = strsub
.Body = strbody
'You can add a file to the mail like this
'.Attachments.Add ("C:\test.txt")
.Display ' or use .Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
No comments:
Post a Comment