Excel emailing when task date is x amount of days away

[Andyg666]

Hi,
I am trying to set up a spreadsheet to monitor our small vehicle fleet.

I have a spreadsheet which we record when the Tax, MOT, Service and Fuel Cards are due, I have conditional formatting set up to change the cells format depending on when they are due.
I would now like to update / automate this a little.
I want to set up way of an email automatically being sent out listing the vehicles and what is due when, the email would go out to an email address or list of email addresses stored cells in the excel sheet -- even better if this could run once a week without having to open the file using OneDrive

I have used the following from the web which sort of works but limited to running the macro and returns to much info.
The email would only need to be sent and include vehicles that are due within 30 days.

Hope this makes sense.


Sub SendEmailReminder()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim cell As Range
Set OutlookApp = CreateObject("Outlook.Application")
For Each cell In Range("B2:B10")
If cell.Value <= Date Then
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "your-email@example.com"
.Subject = "Task Reminder"
.Body = "Task " & cell.Offset(0, -1).Value & " is due!"
.Send
End With
End If
Next cell
End Sub

 

[Rhodie72]

Hi,
I am trying to set up a spreadsheet to monitor our small vehicle fleet.

I have a spreadsheet which we record when the Tax, MOT, Service and Fuel Cards are due, I have conditional formatting set up to change the cells format depending on when they are due.
I would now like to update / automate this a little.
I want to set up way of an email automatically being sent out listing the vehicles and what is due when, the email would go out to an email address or list of email addresses stored cells in the excel sheet -- even better if this could run once a week without having to open the file using OneDrive

I have used the following from the web which sort of works but limited to running the macro and returns to much info.
The email would only need to be sent and include vehicles that are due within 30 days.

Hope this makes sense.


Sub SendEmailReminder()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim cell As Range
Set OutlookApp = CreateObject("Outlook.Application")
For Each cell In Range("B2:B10")
If cell.Value <= Date Then
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "your-email@example.com"
.Subject = "Task Reminder"
.Body = "Task " & cell.Offset(0, -1).Value & " is due!"
.Send
End With
End If
Next cell
End Sub

you might try this. I hope it works for you the way I think it should, according to your explanation.

Sub SendEmailReminder()
    Dim OutlookApp As Object, OutlookMail As Object
    Dim cell As Range, lastRow As Long, dueDate As Date
    Dim reminderBody As String, recipients As String, vehicleName As String, taskDue As String

    ' Set the range for your data, change B2:B10 to the actual range you are using
    lastRow = ThisWorkbook.Sheets("VehicleData").Cells(ThisWorkbook.Sheets("VehicleData").Rows.Count, "B").End(xlUp).Row
    reminderBody = "The following vehicles have tasks due in the next 30 days:" & vbCrLf & vbCrLf
    
    ' Define the email recipients stored in your sheet (for example, Column D)
    recipients = Join(Application.Transpose(ThisWorkbook.Sheets("VehicleData").Range("D2:D10").Value), "; ")

    ' Create Outlook application object
    Set OutlookApp = CreateObject("Outlook.Application")
    
    ' Loop through the vehicles in your list (adjust columns as needed)
    For Each cell In ThisWorkbook.Sheets("VehicleData").Range("B2:B" & lastRow)
        vehicleName = cell.Offset(0, -1).Value  ' Assuming vehicle name is in column A
        taskDue = cell.Offset(0, 1).Value  ' Task name (Tax, MOT, etc.) in column C
        dueDate = cell.Value  ' Date the task is due (column B)
        
        ' Check if the due date is within the next 30 days
        If dueDate >= Date And dueDate <= Date + 30 Then
            reminderBody = reminderBody & vehicleName & ": " & taskDue & " is due on " & dueDate & vbCrLf
        End If
    Next cell

    ' If there are tasks due in the next 30 days, send the email
    If Len(reminderBody) > Len("The following vehicles have tasks due in the next 30 days:" & vbCrLf & vbCrLf) Then
        Set OutlookMail = OutlookApp.CreateItem(0)
        With OutlookMail
            .To = recipients  ' Send to list of recipients
            .Subject = "Vehicle Task Due Reminder"
            .Body = reminderBody
            .Send
        End With
    Else
        MsgBox "No vehicles have tasks due within the next 30 days."
    End If
End Sub

 

[Andyg666]

you might try this. I hope it works for you the way I think it should, according to your explanation.

Sub SendEmailReminder()
    Dim OutlookApp As Object, OutlookMail As Object
    Dim cell As Range, lastRow As Long, dueDate As Date
    Dim reminderBody As String, recipients As String, vehicleName As String, taskDue As String

    ' Set the range for your data, change B2:B10 to the actual range you are using
    lastRow = ThisWorkbook.Sheets("VehicleData").Cells(ThisWorkbook.Sheets("VehicleData").Rows.Count, "B").End(xlUp).Row
    reminderBody = "The following vehicles have tasks due in the next 30 days:" & vbCrLf & vbCrLf
   
    ' Define the email recipients stored in your sheet (for example, Column D)
    recipients = Join(Application.Transpose(ThisWorkbook.Sheets("VehicleData").Range("D2:D10").Value), "; ")

    ' Create Outlook application object
    Set OutlookApp = CreateObject("Outlook.Application")
   
    ' Loop through the vehicles in your list (adjust columns as needed)
    For Each cell In ThisWorkbook.Sheets("VehicleData").Range("B2:B" & lastRow)
        vehicleName = cell.Offset(0, -1).Value  ' Assuming vehicle name is in column A
        taskDue = cell.Offset(0, 1).Value  ' Task name (Tax, MOT, etc.) in column C
        dueDate = cell.Value  ' Date the task is due (column B)
       
        ' Check if the due date is within the next 30 days
        If dueDate >= Date And dueDate <= Date + 30 Then
            reminderBody = reminderBody & vehicleName & ": " & taskDue & " is due on " & dueDate & vbCrLf
        End If
    Next cell

    ' If there are tasks due in the next 30 days, send the email
    If Len(reminderBody) > Len("The following vehicles have tasks due in the next 30 days:" & vbCrLf & vbCrLf) Then
        Set OutlookMail = OutlookApp.CreateItem(0)
        With OutlookMail
            .To = recipients  ' Send to list of recipients
            .Subject = "Vehicle Task Due Reminder"
            .Body = reminderBody
            .Send
        End With
    Else
        MsgBox "No vehicles have tasks due within the next 30 days."
    End If
End Sub

Hi,
Looks like this SHOULD work but I can't get it to, what am i changing things to emails addresses will live in row m cells m2:m12 My pic shows what the cell numbers are. Sorry for being dense. Thanks Again

 

[Andyg666]

you might try this. I hope it works for you the way I think it should, according to your explanation.

Sub SendEmailReminder()
    Dim OutlookApp As Object, OutlookMail As Object
    Dim cell As Range, lastRow As Long, dueDate As Date
    Dim reminderBody As String, recipients As String, vehicleName As String, taskDue As String

    ' Set the range for your data, change B2:B10 to the actual range you are using
    lastRow = ThisWorkbook.Sheets("VehicleData").Cells(ThisWorkbook.Sheets("VehicleData").Rows.Count, "B").End(xlUp).Row
    reminderBody = "The following vehicles have tasks due in the next 30 days:" & vbCrLf & vbCrLf
   
    ' Define the email recipients stored in your sheet (for example, Column D)
    recipients = Join(Application.Transpose(ThisWorkbook.Sheets("VehicleData").Range("D2:D10").Value), "; ")

    ' Create Outlook application object
    Set OutlookApp = CreateObject("Outlook.Application")
   
    ' Loop through the vehicles in your list (adjust columns as needed)
    For Each cell In ThisWorkbook.Sheets("VehicleData").Range("B2:B" & lastRow)
        vehicleName = cell.Offset(0, -1).Value  ' Assuming vehicle name is in column A
        taskDue = cell.Offset(0, 1).Value  ' Task name (Tax, MOT, etc.) in column C
        dueDate = cell.Value  ' Date the task is due (column B)
       
        ' Check if the due date is within the next 30 days
        If dueDate >= Date And dueDate <= Date + 30 Then
            reminderBody = reminderBody & vehicleName & ": " & taskDue & " is due on " & dueDate & vbCrLf
        End If
    Next cell

    ' If there are tasks due in the next 30 days, send the email
    If Len(reminderBody) > Len("The following vehicles have tasks due in the next 30 days:" & vbCrLf & vbCrLf) Then
        Set OutlookMail = OutlookApp.CreateItem(0)
        With OutlookMail
            .To = recipients  ' Send to list of recipients
            .Subject = "Vehicle Task Due Reminder"
            .Body = reminderBody
            .Send
        End With
    Else
        MsgBox "No vehicles have tasks due within the next 30 days."
    End If
End Sub

Okay I got it to work with the below vba code BUT..... this returns AB01 ABC : Tax Due is due on xx/xx/xxx which is correct (if the date is in 30 days). If the other items are due (e.g. MOT ) for the same vehicle then the registration is not included on the MOT line in the email but the department is included and so on. (see test email below)

What am I doing wrong? I changed the dates of when each item was due on the first vehicle to test to code and got the following email for the first vehicle
How can I include the registration on each line needed and stop the formula using the next cell along

The following vehicles have tasks due in the next 30 days:

AB01 ABC : Tax Due is due on 28/03/2025
ABC: MOT expiry is due on 29/03/2025
: Service Due is due on 30/03/2025
28/03/2025: Fuel Card is due on 31/03/2025

Sub SendEmailReminder()
    Dim OutlookApp As Object, OutlookMail As Object
    Dim cell As Range, lastRow As Long, dueDate As Date
    Dim reminderBody As String, recipients As String, vehicleName As String, taskDue As String

    ' Set the range for your data, change B2:B10 to the actual range you are using
    lastRow = ThisWorkbook.Sheets("Sheet1").Cells(ThisWorkbook.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
    reminderBody = "The following vehicles have tasks due in the next 30 days:" & vbCrLf & vbCrLf
    
    ' Define the email recipients stored in your sheet (for example, Column D)
    recipients = Join(Application.Transpose(ThisWorkbook.Sheets("Sheet1").Range("i2:i3").Value), "; ")

    ' Create Outlook application object
    Set OutlookApp = CreateObject("Outlook.Application")
    
    ' Loop through the vehicles in your list (adjust columns as needed)
    For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A4:g12" & lastRow)
        vehicleName = cell.Offset("0", "0").Value ' Assuming vehicle name is in column A
        taskDue = cell.Offset(-1, 3).Value  ' Task name (Tax, MOT, etc.) in column C
        dueDate = cell.Offset(0, 3).Value ' Date the task is due (column B)
        
        ' Check if the due date is within the next 30 days
        If dueDate >= Date And dueDate <= Date + 30 Then
            reminderBody = reminderBody & vehicleName & ": " & taskDue & " is due on " & dueDate & vbCrLf
        End If
    Next cell

    ' If there are tasks due in the next 30 days, send the email
    If Len(reminderBody) > Len("The following vehicles have tasks due in the next 30 days:" & vbCrLf & vbCrLf) Then
        Set OutlookMail = OutlookApp.CreateItem(0)
        With OutlookMail
            .To = recipients  ' Send to list of recipients
            .Subject = "Vehicle Task Due Reminder"
            .Body = reminderBody
            .Send
        End With
    Else
        MsgBox "No vehicles have tasks due within the next 30 days."
    End If
End Sub