Junaed-Ar-Rahman

Thank you DENNIS for your comment.
The code is automatic since whenever you run it, you don’t need to check which deadlines are 1 to 7 days away from the current date. Also, the code creates a draft automatically. However, if you want to automate the whole process, you will have to modify the code slightly and create a task scheduler. Copy the following code and paste it into the VBA module:

Private Sub Workbook_Open()
    ' Call the SendReminderMailAutomatically subroutine when the workbook is opened
    SendReminderMailAutomatically
End Sub

Public Sub SendReminderMailAutomatically()
    Public Sub SendReminderMailAutomatically()
    ' Declare the variables
    Dim ws As Worksheet
    Dim XDueDate As Range
    Dim XRcptsEmail As Range
    Dim xMailContent As Range
    Dim xCrtOut As Object
    Dim k As Long
    Dim xMailSections As Object
    Dim xFinalRw As Long
    Dim CrVbLf As String
    Dim xMsg As String
    Dim xSubEmail As String
    On Error Resume Next
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("YourSheetName") ' Replace "YourSheetName" with the actual sheet name
    
    ' Define the ranges from the worksheet
    Set XDueDate = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' Assuming due dates are in column A starting from row 2
    Set XRcptsEmail = ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row) ' Assuming email addresses are in column B starting from row 2
    Set xMailContent = ws.Range("C2:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row) ' Assuming email content is in column C starting from row 2
    
    ' Count rows for the due dates
    xFinalRw = XDueDate.Rows.Count
    
    ' Set command to open MS Outlook Application
    Set xCrtOut = CreateObject("Outlook.Application")
    
    ' Apply For loop to conduct the operation in each row one by one
    For k = 1 To xFinalRw
        ' Apply If condition for the Due Date values
        If XDueDate.Cells(k).Value  "" Then
            ' Condition set to send mail if the difference between due dates and current date is greater than 1 and less than 7 days
            ' Means 1 < X < 7, X = Due Date - Current Date
            If CDate(XDueDate.Cells(k).Value) - Date  0 Then
                ' Create the subject, body, and text contents with the required variables
                xValSendRng = XRcptsEmail.Cells(k).Value
                xSubEmail = xMailContent.Cells(k).Value & " on " & XDueDate.Cells(k).Value
                CrVbLf = vbCrLf
                xMsg = "Dear " & xValSendRng & CrVbLf
                xMsg = xMsg & "Text : " & xMailContent.Cells(k).Value & CrVbLf
                
                ' Create the email
                Set xMailSections = xCrtOut.CreateItem(0)
                
                ' Define the position to place the Subject, Body, and Recipients Address
                With xMailSections
                    .Subject = xSubEmail
                    .To = xValSendRng
                    .Body = xMsg
                    .Send
                End With
                
                Set xMailSections = Nothing
            End If
        End If
    Next
    
    Set xCrtOut = Nothing
End Sub
    MsgBox "Reminder emails have been sent.", vbInformation
End Sub

Create a task-scheduler:
Now, follow the steps below to create a task scheduler:
1. Type “Task Scheduler” in the Windows search bar and press “Enter”.
2. In the right-hand Actions pane, click on “Create Basic Task”. Set a name and description for your task.
3. Choose Daily in the “Trigger” option and Start a Program in the “Action” part.
4. In the Program/Script box, give the directory of “excel.exe” file.
5. In the “Add arguments” field, specify the full path to your Excel file.
6. Click “Finish.”

Hopefully, following the steps above, you will be able to perform your desired task.

Regards
Md Junaed Ar Rahman

Hello Terry Smith,

Thanks for your question. Most probably you are using a function like TODAY() function to find the first date in our worksheet. Then you have applied the Fill Handle feature. That’s why, the days are updating every day. The solution to this problem is to manually input the first date and then apply the Fill Handle feature.

Also, if your problem is different from the problem that I have assumed, then give us the Excel files. It will be convenient for us to solve the issue.