CheckExpirationDates and Email

Sub ScheduleDailyCheck()
    ' Schedule the CheckExpirationDates macro to run at a specific time each day
    Application.OnTime TimeValue("08:00:00"), "CheckExpirationDates"
End Sub
Sub CheckExpirationDates()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentRow As Long
    Dim expDateJ As Date
    Dim expDateK As Date
    Dim emailSubject As String
    Dim emailBody As String
    Dim personInfo As Collection
    Dim personKey As String

    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("2024 Season") ' Change "Sheet1" to the actual sheet name

    ' Find the last row with data in column B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    ' Initialize email body and collection for person information
    emailBody = ""
    Set personInfo = New Collection

    ' Loop through rows starting from 2 to the last row
    For currentRow = 2 To lastRow
        ' Check if expiration date in Column J is before today
        If IsDate(ws.Cells(currentRow, 10).Value) Then
            expDateJ = CDate(ws.Cells(currentRow, 10).Value)
            ' Check if expiration date in Column K is before today
            If IsDate(ws.Cells(currentRow, 11).Value) Then
                expDateK = CDate(ws.Cells(currentRow, 11).Value)

                ' Check if either document is expired
                If expDateJ < Date Or expDateK < Date Then
                    ' Check if Column L is empty
                    If IsEmpty(ws.Cells(currentRow, 12).Value) Then
                        ' Insert "Emailed" in Column L
                        ws.Cells(currentRow, 12).Value = "Emailed"

                        ' Add information to the personInfo collection
                        personKey = ws.Cells(currentRow, 2).Value
                        If Not ContainsPerson(personInfo, personKey) Then
                            personInfo.Add personKey, personKey
                            ' Add information to the email body
                            emailBody = emailBody & "Name: " & personKey & vbCrLf
                        End If
                        ' Add document information to the email body
                        emailBody = emailBody & "Document Expired: " & _
                                     IIf(expDateJ < Date, "RV Insurance", "") & _
                                     IIf(expDateJ < Date And expDateK < Date, vbCrLf, "") & _
                                     IIf(expDateK < Date, "Golf Cart Insurance", "") & vbCrLf & vbCrLf
                    End If
                End If
            End If
        End If
    Next currentRow

    ' Check if there are expired policies to notify about
    If Len(emailBody) > 0 Then
        ' Prepare email subject
        emailSubject = "Expired Insurance Policies Notification"

        ' Send email using Outlook
        SendEmail "Redacted", emailSubject, emailBody
    End If
End Sub

Function ContainsPerson(col As Collection, key As String) As Boolean
    On Error Resume Next
    ContainsPerson = (col(key) Is Nothing)
    On Error GoTo 0
End Function

Sub SendEmail(recipient As String, subject As String, body As String)
    ' Send email using Outlook
    Dim OutlookApp As Object
    Dim MailItem As Object

    On Error Resume Next ' Ignore errors if Outlook is not open

    ' Attempt to get Outlook Application
    Set OutlookApp = GetObject(, "Outlook.Application")

    On Error GoTo 0 ' Reset error handling

    If OutlookApp Is Nothing Then
        ' If Outlook is not open, create a new instance
        Set OutlookApp = CreateObject("Outlook.Application")
    End If

    ' Create a new mail item
    Set MailItem = OutlookApp.CreateItem(0)

    ' Fill in email details
    MailItem.To = recipient
    MailItem.subject = subject
    MailItem.body = body

    ' Send the email
    MailItem.Send

    ' Clean up objects
    Set MailItem = Nothing
    Set OutlookApp = Nothing
End Sub
Sub CancelScheduledCheck()
    ' Cancel the scheduled CheckExpirationDates macro
    On Error Resume Next
    Application.OnTime TimeValue("08:00:00"), "CheckExpirationDates", , False
    On Error GoTo 0
End Sub