Not knowing where the Date value is stored on your worksheet, I assumed Cell "A1".
This code should get you started, if the date in cell "A1" is equal to today (the current date) (Now) it will process an email. The user will be prompted to enter an email address. If the date in cell "A1" is older than today the user will be prompted with a message box that the date has expired also showing the date in cell "A1" and the current date (Now).
Option Explicit
Sub SendEmail()
Dim oOutlook As Object
Dim oMailItem As Object
Dim oRecipient As Object
Dim sRecipient As String
Dim oNameSpace As Object
sRecipient = InputBox("Enter Your Email Address Here!")
If ActiveSheet.Range("A1").Value = Now Then
Set oOutlook = CreateObject("Outlook.Application")
Set oNameSpace = oOutlook.GetNameSpace("MAPI")
oNameSpace.Logon , , True
Set oMailItem = oOutlook.CreateItem(0)
Set oRecipient = _
oMailItem.Recipients.Add(sRecipient)
oRecipient.Type = 1 '1 = To, use 2 for cc
'keep repeating these lines with
'your names, adding to the collection.
With oMailItem
.Subject = "This is an automatic email notification: Bad Link from SPEC INDEX Excel File!"
.body = "Please enter the following information along with a brief description of the problem!" _
& vbCr & "Spec Name:" & vbCr & "Worksheet Name:" & vbCr & "Cell Address:" & vbCr & "Description:"
' .Attachments.Add ("filename") 'you only need this if
'you are sending attachments?
.Display 'use .Send when all testing done
End With
Set oRecipient = Nothing
Set oMailItem = Nothing
Set oNameSpace = Nothing
Set oOutlook = Nothing
Else
If ActiveSheet.Range("A1").Value < Now Then
MsgBox ActiveSheet.Range("A1").Value & " Date Expired! " & " Today is " & (Now)
End If
End If
End Sub
Ref: oldchippy
I believe the above code is from Rons site
Bookmarks