Thread: Auto Email on Workbook open based on dates

I have looked at these threads from here;
http://www.excelforum.com/excel-prog...o-outlook.html
and
http://www.excelforum.com/excel-prog...date-past.html

They are not quite working for me. Here is what I have. in column L starting row 3 down to about 300 I have to enter dates that a task was completed. These tasks have to be redone each year so I want a 60 day notice to start the process.

The email addresses that they need to go to are in Z1 but that part of the code works.

So the just of it, when someone opens the workbook, the macro runs and checks the dates in column L starting at L3, if a date is found to be lets say 300 days old excel generates and email to the contacts in z1. But if the fields are blank I want them to be ignored.

Thanks for any help you can provide.

Got it figured out, it checks 4 colums for certain dates then generates an email with the required information in the subject line and body.

The only thing I would like to tweek is if I could get it all in one email report instead of a hundred or so. Here is the code.

Private Sub Workbook_Open()
 Dim Cell As Range
    Dim DateRng As Range
    Dim Msg As String
    Dim olApp As Object
    Dim olEmail As Object
    Dim RngEnd As Range
    Dim Wks As Worksheet
    Dim xRow As Integer
    Dim xCol As Integer
    
    'Added fields
    Dim eDefault As String
    eDefault = "Default Email Address"
    
    Set Wks = Worksheets("Work Site Info")
    ' Hans: 6 June: Will not use the three lines below
    Set DateRng = Wks.Range("J3")
    Set RngEnd = Wks.Range("J331")
    Set DateRng = IIf(RngEnd.Row < DateRng.Row, DateRng, Wks.Range(DateRng, RngEnd))
    
    For xRow = 3 To 331
        If Len(Trim(Range("Y" & xRow).Value)) = 0 Then
            Range("AA" & xRow).Value = 0
        Else
            Range("AA" & xRow).Value = IIf(Date - Range("Y" & xRow).Value <= 10, 0, 1)
        End If
        If (Len(Trim(Wks.Range("J" & xRow).Value) & Trim(Wks.Range("K" & xRow).Value & _
            Trim(Wks.Range("L" & xRow).Value) & Trim(Wks.Range("U" & xRow).Value))) > 0) Then
            If Range("X" & xRow).Value = False Or Range("AA" & xRow).Value = 1 Then
            
               'Change this to what you want.
               
                Msg = "Please note that the following have documents with in 65 days of the expiration date:" & Chr(10)
            
                If Wks.Range("J" & xRow).Value - Date <= 65 And Len(Trim(Wks.Range("J" & xRow).Value)) > 0 Then
                Msg = Msg & Chr(9) & Wks.Range("A" & xRow).Value & " " & Wks.Range("C" & xRow).Value & ", " & Wks.Range("D" & xRow).Value & " " & "-" & Wks.Range("J2").Value & _
                Chr(9) & "expiration date : " & Wks.Range("J" & xRow).Value & "    " & Wks.Range("J" & xRow).Value - Date & " days." & Chr(10)
            End If
            If Wks.Range("L" & xRow).Value - Date <= 65 And Len(Trim(Wks.Range("L" & xRow).Value)) > 0 Then
                Msg = Msg & Chr(9) & Wks.Range("A" & xRow).Value & " " & Wks.Range("C" & xRow).Value & ", " & Wks.Range("D" & xRow).Value & " " & "-" & Wks.Range("L2").Value & _
                Chr(9) & "expiration date : " & Wks.Range("L" & xRow).Value & "    " & Wks.Range("L" & xRow).Value - Date & " days."
            End If
            If Wks.Range("T" & xRow).Value - Date <= -65 And Len(Trim(Wks.Range("T" & xRow).Value)) > 0 Then
                Msg = Msg & Chr(9) & Wks.Range("A" & xRow).Value & " " & Wks.Range("C" & xRow).Value & ", " & Wks.Range("D" & xRow).Value & " " & "-" & Wks.Range("T2").Value & _
                Chr(9) & "expiration date : " & Wks.Range("T" & xRow).Value & "    " & Wks.Range("T" & xRow).Value - Date & " days."
            End If
            If Wks.Range("U" & xRow).Value - Date <= -65 And Len(Trim(Wks.Range("U" & xRow).Value)) > 0 Then
                Msg = Msg & Chr(9) & Wks.Range("A" & xRow).Value & " " & Wks.Range("C" & xRow).Value & ", " & Wks.Range("D" & xRow).Value & " " & "-" & Wks.Range("U2").Value & _
                Chr(9) & "expiration date : " & Wks.Range("U" & xRow).Value & "    " & Wks.Range("U" & xRow).Value - Date & " days."
            End If
                If Range("AA" & xRow).Value = 1 Then
                    Msg = Msg & Chr(10) & "A message reminding you was sent on " & Range("Y" & xRow).Value & Chr(10) & _
                        "No action has yet been taken." & Chr(10)
                End If
                If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
                Set olEmail = olApp.CreateItem(0)
                With olEmail
                    .To = Range("Z3").Value & "; " & Range("Z4").Value & "; " & Range("Z5").Value & "; " & Range("Z6").Value
                    .Subject = Wks.Range("A" & xRow).Value & " " & Wks.Range("C" & xRow).Value & ", " & Wks.Range("D" & xRow).Value & " " & "has expiring documents on your task order that require your attention."
                    .Body = Msg
                    .Send
                End With
                Range("X" & xRow).Value = True
                Range("Y" & xRow).Value = Date
                Range("AA" & xRow).Value = IIf(Date - Range("Y" & xRow).Value <= 5, 0, 1)
            End If
        End If
    Next xRow
    
    Set olApp = Nothing
End Sub