Auto Email when date in cell range reached.

[Dave Ashcroft]

Need help!!<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
I have been addapting code from Ron De Bruin and anthonya2369 to come up with a spread sheet that emails three people when certification in training courses expire.<o></o>
I need the data to in columns with Name Employee # and the course expirey date; eg;<o></o>
<o></o>
<TABLE class=MsoNormalTable style="WIDTH: 304pt; BORDER-COLLAPSE: collapse; mso-padding-alt: 0in 0in 0in 0in" cellSpacing=0 cellPadding=0 width=405 border=0 u1:str><COLGROUP><COL style="WIDTH: 69pt; mso-width-source: userset; mso-width-alt: 3364" width=92><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 56pt; mso-width-source: userset; mso-width-alt: 2706" width=74><COL style="WIDTH: 131pt; mso-width-source: userset; mso-width-alt: 6400" width=175><TBODY><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes"><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: windowtext 1pt solid; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: windowtext 1pt solid; WIDTH: 69pt; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-alt: solid windowtext .5pt" width=92>A1<o></o>
</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: windowtext 1pt solid; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; WIDTH: 48pt; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-top-alt: solid windowtext .5pt; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt" width=64>B1<o></o>
</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: windowtext 1pt solid; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; WIDTH: 56pt; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-top-alt: solid windowtext .5pt; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt" width=75>C1<o></o>
</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: windowtext 1pt solid; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; WIDTH: 131pt; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-top-alt: solid windowtext .5pt; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt" width=175>D1<o></o>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 1"><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: #d4d0c8; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: windowtext 1pt solid; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt; mso-border-left-alt: solid windowtext .5pt">Name<o></o>
</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: #d4d0c8; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt">Badge#<o></o>
</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: #d4d0c8; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt">Dri Lic exp<o></o>
</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: #d4d0c8; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt">Expires IN<o></o>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 2; mso-yfti-lastrow: yes"><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: #d4d0c8; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: windowtext 1pt solid; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt; mso-border-left-alt: solid windowtext .5pt">Ashcroft D<o></o>
</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: #d4d0c8; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt" u1:num>

69280<o></o>​

</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: #d4d0c8; PADDING-LEFT: 0in; BACKGROUND: yellow; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt; mso-border-left-alt: solid windowtext .5pt" u1:num="39916">

4/13/2009<o></o>​

</TD><TD style="BORDER-RIGHT: windowtext 1pt solid; PADDING-RIGHT: 0in; BORDER-TOP: #d4d0c8; PADDING-LEFT: 0in; PADDING-BOTTOM: 0in; BORDER-LEFT: #d4d0c8; PADDING-TOP: 0in; BORDER-BOTTOM: windowtext 1pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-border-bottom-alt: solid windowtext .5pt; mso-border-right-alt: solid windowtext .5pt">Expiring Less Than 30 Days<o></o>
</TD></TR></TBODY></TABLE>

There are 25 course and 200 employees to be tracked. <o></o>
<o> </o>
<COLGROUP><COL style="WIDTH: 69pt; mso-width-source: userset; mso-width-alt: 3364" width="92"><COL style="WIDTH: 48pt" width="64"><COL style="WIDTH: 56pt; mso-width-source: userset; mso-width-alt: 2706" width="74"><COL style="WIDTH: 131pt; mso-width-source: userset; mso-width-alt: 6400" width="175">I am using Office 2003 and Outlook Express.<o></o>
At pressent I am using a worksheet for each course with the following code, but I am having several problems. I cant get vbTab to give the spacings in the rondebruins code, and when it sends the Emails it freezes the Reading Pain in OutlookExpress and locked up Outlook if my code had to start Outlookexpress. Any suggestions.<o></o>
<o></o>
ThisWorkbook code;<o></o>
<o> </o>
Private Sub Workbook_Open()<o></o>
<o> </o>
If Sheets("Sheet1").Cells(1, 2).Value <> Date Then<o></o>
Sheets("Sheet1").Cells(1, 2).Value = Date<o></o>
End If<o></o>
<o></o>
If Sheets("Sheet2").Cells(1, 2).Value <> Date Then<o></o>
Sheets("Sheet2").Cells(1, 2).Value = Date<o></o>
<o></o>
End If<o></o>
<o> </o>
End Sub<o></o>
<o> </o>
Sheet1 code<o></o>
<o> </o>
Private Sub Worksheet_Change(ByVal Target As Range)<o></o>
<o> </o>
Dim oCell As Range<o></o>
Dim strBody As String<o></o>
<o> </o>
If Target.Row <> 1 And Target.Column <> 1 Then<o></o>
Exit Sub<o></o>
End If<o></o>
<o> </o>
strBody = " Name " & Space(10) & " Badge # " & Space(10) & "Expire Date" & Space(10) & "Days to Expiration" & vbCrLf & vbCrLf<o></o>
<o> </o>
For Each oCell In Range("d7:d20")<o></o>
If oCell.Value <> "" Then<o></o>
strBody = strBody & _<o></o>
Left(oCell.Offset(0, -3).Value, 10) & Space(10) & oCell.Offset(0, -2) & Space(10 - Len(oCell.Offset(0, -2).Value)) & Space(10) & oCell.Offset(0, -1).Value & Space(10) & oCell.Value & vbCrLf<o></o>
End If<o></o>
Next oCell<o></o>
<o> </o>
Call Mail_Outlook_Express(ByVal strBody)<o></o>
<o> </o>
End Sub<o></o>
<o> </o>
Sub Mail_Outlook_Express(ByVal strBody As String)<o></o>
Dim Recipient As String, Subj As String, HLink As String<o></o>
Dim Recipientcc As String, Recipientbcc As String<o></o>
Dim msg As String<o></o>
Recipient = "ashcrodx"<o></o>
Recipientcc = ""<o></o>
Recipientbcc = ""<o></o>
Subj = "Driving Liecence Expired"<o></o>
msg = strBody<o></o>
<o></o>
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")<o></o>
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc _<o></o>
& " " & " " & Recipientbcc & "&"<o></o>
HLink = HLink & "subject=" & Subj & "&"<o></o>
HLink = HLink & "body=" & msg<o></o>
ActiveWorkbook.FollowHyperlink (HLink)<o></o>
Application.Wait (Now + TimeValue("0:00:02"))<o></o>
Application.SendKeys "%s"<o></o>
End Sub<o></o>
<o> </o>
<o> </o>
Sheet2 code<o></o>
<o> </o>
Private Sub Worksheet_Change(ByVal Target As Range)<o></o>
<o> </o>
Dim oCell As Range<o></o>
Dim strBody As String<o></o>
<o> </o>
If Target.Row <> 1 And Target.Column <> 1 Then<o></o>
Exit Sub<o></o>
End If<o></o>
<o> </o>
strBody = " Name " & Space(10) & " Badge # " & Space(10) & "Expire Date" & Space(10) & "Days to Expiration" & vbCrLf & Space(10) & vbCrLf<o></o>
<o> </o>
For Each oCell In Range("d7:d20")<o></o>
If oCell.Value <> "" Then<o></o>
strBody = strBody & _<o></o>
Left(oCell.Offset(0, -3).Value, 10) & Space(10) & oCell.Offset(0, -2) & Space(10 - Len(oCell.Offset(0, -2).Value)) & Space(10) & oCell.Offset(0, -1).Value & Space(10) & oCell.Value & vbCrLf<o></o>
End If<o></o>
Next oCell<o></o>
<o> </o>
Call Mail_Outlook_Express(ByVal strBody)<o></o>
<o> </o>
End Sub<o></o>
<o> </o>
<o> </o>
<o> </o>
Sub Mail_Outlook_Express(ByVal strBody As String)<o></o>
Dim Recipient As String, Subj As String, HLink As String<o></o>
Dim Recipientcc As String, Recipientbcc As String<o></o>
Dim msg As String<o></o>
Recipient = "ashcrodx"<o></o>
Recipientcc = ""<o></o>
Recipientbcc = ""<o></o>
Subj = "Work Permit Expired"<o></o>
msg = strBody<o></o>
<o></o>
msg = WorksheetFunction.Substitute(msg, vbNewLine, "%0D%0A")<o></o>
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc _<o></o>
& " " & " " & Recipientbcc & "&"<o></o>
HLink = HLink & "subject=" & Subj & "&"<o></o>
HLink = HLink & "body=" & msg<o></o>
ActiveWorkbook.FollowHyperlink (HLink)<o></o>
Application.Wait (Now + TimeValue("0:00:02"))<o></o>
Application.SendKeys "%s"<o></o>
'Application.Wait (Now + TimeValue("0:00:12"))<o></o>
'Application.Quit<o></o>
End Sub<o></o>
<o> </o>
<o> </o>