Sending an E-mail when a Due Date is Reached

@ady
Q: Can the ouptut email text be formatted for colour, font etc?
1: If you use the Tip's CreateObject("Outlook.Application") method, maybe with additional code.
2: If you use my ScheduleEmail macro below, no.
3: My Excel Toolbox's ToggleOutlookEnvelope macro makes it easy to send a sheet's formatted content in the body of an email message. See my comment dated 2023-10-01 and my 3 follow-up comments here: https://excelribbon.tips.net/T008508

Hi All,

Can the ouptut email text be formatted for colour, font etc?

thanks

@ganesh
See https://www.thevbahelp.com/post/what-is-vba

Hi Sir,

I am using office 365 , How to implement above code .. Please help me.

In my last comment (yesterday) I said, "Also, any quotation marks (") in the mailto string will be replaced by apostrophes (')." This was unnecessary; they should be replace by %22 instead, which is the mailto URL equivalent of a quotation mark. In addition, it is no longer necessary to insure the active sheet is a worksheet because no hyperlink is involved. So here's an updated version of the ScheduleEmail macro.

Public Sub ScheduleEmail()
    Const MyName As String = "ScheduleEmail"
    Const A As String = "&", B As String = ""
    Const Q As String = """", QQ As String = Q & Q
    Const HdrRow As Integer = 1 'row 1
    Const SendTo As Integer = 2 'col B
    Const SendCC As Integer = 3 'col C
    Const SendBCC As Integer = 4 'col D
    Const Subject As Integer = 5 'col E
    Const Message As Integer = 6 'col F
    Const Schedule As Integer = 7 'col G
    Const Prepared As Integer = 8 'col H
    Dim WS As Worksheet, sMailTo As String, vTask As Variant
    Dim nLastSched As Long, nRow As Long, nCount As Long
    On Error Resume Next
    Set WS = Worksheets(MyName)
    If Err Then
        MsgBox "The " & MyName & " worksheet is missing", vbCritical, MyName
        Exit Sub
    End If
    On Error GoTo 0
    With WS
        'accommodate hidden rows
        nLastSched = .Columns(Schedule).Find(What:="*", _
            After:=.Columns(Schedule).Cells(1), LookAt:=xlPart, _
            LookIn:=xlFormulas, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False).Row
        For nRow = (HdrRow + 1) To nLastSched
            If IsDate(.Cells(nRow, Schedule)) _
            And Now >= .Cells(nRow, Schedule) _
            And .Cells(nRow, Prepared) = B Then
                sMailTo = "mailto:" & .Cells(nRow, SendTo) & "?" & _
                    IIf(.Cells(nRow, Subject) = B, B, "subject=" & _
                        .Cells(nRow, Subject) & A) & _
                    IIf(.Cells(nRow, SendCC) = B, B, "cc=" & _
                        .Cells(nRow, SendCC) & A) & _
                    IIf(.Cells(nRow, SendBCC) = B, B, "bcc=" & _
                        .Cells(nRow, SendBCC) & A) & _
                    IIf(.Cells(nRow, Message) = B, B, "body=" & _
                        .Cells(nRow, Message))
                sMailTo = Q & Replace(sMailTo, Q, "%22") & Q
                sMailTo = "cmd /c start " & QQ & " " & sMailTo
                If Len(sMailTo) > 8191 Then
                    vTask = (Len(sMailTo) - 8191) & " too many characters"
                ElseIf Len(sMailTo) > Len("mailto:?") Then
                    vTask = Shell(sMailTo, vbHide)
                    vTask = IIf(vTask = 0, CVErr(xlErrBlocked), Now)
                    nCount = nCount + 1
                End If
                .Cells(nRow, Prepared) = vTask
            End If
        Next nRow
    End With
    sMailTo = IIf(nCount = 1, " email was", " emails were") & " prepared"
    MsgBox (nCount & sMailTo), vbInformation, MyName
End Sub

This macro should be in a standard module but can be called by the Workbook_Open event procedure. It assumes the active workbook includes a worksheet named ScheduleEmail which does not need to be the active worksheet but must have the structure illustrated in my comment dated June 6. If the 8191 character Shell command line limit is too restrictive, a PowerShell script could be employed instead.

Re. the ScheduleEmail macro in my earlier comment, if the sMailTo variable's length exceeds 1496 characters it cannot be launched as a hyperlink. To support longer messages, the following statements from the original macro
                If Len(sMailTo) > Len("mailto:?") Then
                    .Hyperlinks.Add(rTemp, sMailTo).Follow
                    .Cells(nRow, Prepared) = Now
                    rTemp.ClearHyperlinks
                    rTemp.ClearContents
should be replaced by these statements
                Const Q As String = """", QQ As String = Q & Q
                sMailTo = Q & Replace(sMailTo, Q, "'") & Q
                sMailTo = "cmd /c start " & QQ & " " & sMailTo
                If Len(sMailTo) > 8191 Then
                    .Cells(nRow, Prepared) = (Len(sMailTo) - 8191) & _
                        " too many characters"
                ElseIf Len(sMailTo) > Len("mailto:?") Then
                    Dim vTask As Variant
                    vTask = Shell(sMailTo, vbHide)
                    .Cells(nRow, Prepared) = IIf(vTask = 0, "error", Now)
                    nCount = nCount + 1
because the length of a Shell command line should not exceed 8191 characters. In this case the rTemp variable is not used and can be deleted. Also, any quotation marks (") in the mailto string will be replaced by apostrophes ('). For even longer messages, a PowerShell script could be employed.

Re. the ScheduleEmail macro in my previous comment, the following statement
                If Len(sMailTo) > Len("mailto:?") Then
should be replaced by these statements
                If Len(sMailTo) > 1496 Then
                    .Cells(nRow, Prepared) = (Len(sMailTo) - 1496) & _
                        " too many characters"
                ElseIf Len(sMailTo) > Len("mailto:?") Then
because Hyperlink.Address should not exceed 1496 characters.

Here's a macro that prepares scheduled emails using your default mailto client app (such as Outlook or Gmail) which can be set as described here: https://www.makeuseof.com/tag/how-to-change-the-default-email-program-for-mailto-links/
The mailto protocol can prepare an email but only the client app can send it.

Public Sub ScheduleEmail()
    Const MyName As String = "ScheduleEmail"
    Const A As String = "&", B As String = ""
    Const HdrRow As Integer = 1     'row 1
    Const SendTo As Integer = 2     'col B
    Const SendCC As Integer = 3     'col C
    Const SendBCC As Integer = 4    'col D
    Const Subject As Integer = 5    'col E
    Const Message As Integer = 6    'col F
    Const Schedule As Integer = 7 'col G
    Const Prepared As Integer = 8 'col H
    Dim WS As Worksheet, rTemp As Range, sMailTo As String
    Dim nLastSched As Long, nRow As Long, nCount As Long
    On Error Resume Next
    Set WS = Worksheets(MyName)
    If Err Then
        MsgBox "The " & MyName & " worksheet is missing", vbCritical, MyName
        Exit Sub
    End If
    On Error GoTo 0
    With WS
        'active sheet must be a worksheet
        If TypeName(ActiveSheet) <> "Worksheet" Then .Activate
        'accommodate possibly hidden rows
        nLastSched = .Columns(Schedule).Find(What:="*", _
            After:=.Columns(Schedule).Cells(1), LookAt:=xlPart, _
            LookIn:=xlFormulas, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False).Row
        Set rTemp = .Cells((nLastSched + 1), Schedule)
        For nRow = (HdrRow + 1) To nLastSched
            If IsDate(.Cells(nRow, Schedule)) _
            And Now >= .Cells(nRow, Schedule) _
            And .Cells(nRow, Prepared) = B Then
                sMailTo = "mailto:" & .Cells(nRow, SendTo) & "?" & _
                    IIf(.Cells(nRow, Subject) = B, B, "subject=" & _
                        .Cells(nRow, Subject) & A) & _
                    IIf(.Cells(nRow, SendCC) = B, B, "cc=" & _
                        .Cells(nRow, SendCC) & A) & _
                    IIf(.Cells(nRow, SendBCC) = B, B, "bcc=" & _
                        .Cells(nRow, SendBCC) & A) & _
                    IIf(.Cells(nRow, Message) = B, B, "body=" & _
                        .Cells(nRow, Message))
                If Len(sMailTo) > Len("mailto:?") Then
                    .Hyperlinks.Add(rTemp, sMailTo).Follow
                    .Cells(nRow, Prepared) = Now
                    rTemp.ClearHyperlinks
                    rTemp.ClearContents
                    nCount = nCount + 1
                End If
            End If
        Next nRow
    End With
    sMailTo = IIf(nCount = 1, " email was", " emails were") & " prepared"
    MsgBox (nCount & sMailTo), vbInformation, MyName
End Sub

This macro should be in a standard module but can be called by the Workbook_Open event procedure. It assumes the active workbook includes a worksheet named ScheduleEmail which does not need to be the active worksheet but must have a specific structure (see Figure 1 below)

@Gary Nicol
After further review of this ancient material, I believe Allen intended the following statement:
    lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
to refer to column E (5) instead of column C (3) because column E contains the due dates; therefore, change that statement to the following:
    lLastRow = Cells(Rows.Count, 5).End(xlUp).Row

@Gary Nicol
The code in the Tip will work for multiple rows, but be aware of its various assumptions. See my comment dated 2021-10-14.

HI, can it check for multiple rows and if so can someone post code. thanks

Hi Chance

Would you be able to share the code for checking multiple rows/columns?
I have been trying to create based on J Wooley suggestion but I still cant get it working.

Ok, I figured out how to get it to look at multiple rows. Now, is there a way to have put all the past due in one email instead of a separate email for each late item?

This seems to only work for the top row of the list. If the first row is not past due, it does not flag any other rows as past due, or, if the first row is past due, it does not flag additional rows as past due. Very new to VBA so I'm sure I'm missing something.

Hey J.Wooley thank for the reply, I have been trying to add a loop but it still only defaults to the first column, will keep trying.

@Christian Cook

First, there are a few things Allen forgot to mention (for example, see Steve's comment 2016-03-31):
1. The macro must be located in the workbook's ThisWorkbook document module.
2. The macro assumes either there is only a single worksheet in the workbook or the applicable worksheet is always the ActiveSheet when the workbook is opened.
3. The macro assumes column C has the most rows, so
lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
4. The "column" part of Cells(row, column) can be either numeric or text, so
Cells(Rows.Count, 3) is the same as Cells(Rows.Count, "C").

Now, as described in the Tip, the macro makes some assumptions:
1. Project name is in column B: Cells(lRow, 2)
2. The due date is in column E: Cells(lRow, 5)
3. A "flag value" (S) is in column F: Cells(lRow, 6)
4. The date the e-mail was sent is in column G: Cells(lRow, 7)

If you have due dates in two columns N and R, you can simply code two For...Next loops:
First for Cells(lRow, "N") instead of Cells(lRow, 5)
Again for Cells(lRow, "R") instead of Cells(lRow, 5)
But for each loop you must decide where to put the "flag value" instead of Cells(lRow, 6) and the date the e-mail was sent instead of Cells(lRow, 7).
The following statement should only be after the second For...Next loop:
Set OutApp = Nothing

Unrelated to this but for your interest,
see https://sites.google.com/view/MyExcelToolbox/

Hi is there any way to get it to check multiple columns? I have expiry dates in 2 different columns N & R but cannot adjust the code to make this work, thanks in advance

Hi.

Wondering if you could help. The macro seems exactly what I am looking for.
However I do have a few questions about it that I am not currently able to test out for myself.

1) If the macro returns multiple rows with the current date on, how would this be set out?
In the code it just states:
sTemp = sTemp & " " & Cells(lRow,2)
Would this result in one long line of cells that appear in the email body? If so is there anyway that I could get each individual row onto its own line?

2) Is there anyway that I could incorporate this into a table with the headers? (I do realised that I could input a line above to define the headers but I feel formatting may be an issue due to the different lengths of names etc.

Sorry for the questions however I am new to VBA and coding in general.

Please find attached a picture of a test spreadsheet I am work with. Also please be aware that I know I would need to personalise the columns to B-D for the information sent, and A for the date.
(see Figure 1 below)

Cheers,
Kane

@Syed
You might try posting your question to wellsr VBA Q&A at https://ask.wellsr.com/vba

Hi Alan,
I would like to seek your help on writing a code for one of my work sheet I have 100 certificates with specific expiry dates , would like to generate a reminder email 60 days prior to reach the expiry date. is it possible as all these belongs to different owners with different dates ranging 2020 -2023.

Thanks
Syed

I think that if you have a column of email addresses, once you get to the row you want, you should be able to reference the contents of that cell to the .To parameter.

Hi

Each project may be the responsibility of an individual person.

So would it be possible to send to an email address from a particular cell reference?

Any help with this would be greatly appreciated.

@Bob E

Yes you can attach files use:

.Attachments.Add ("D:\tmp\picture.jpg") within the With/Endwith construct

substitute your own filepath/name in the parameters field.

Is it possible to attach files (spreadsheets) to the email? I would have the file name as a field in my spreadsheet, either with directories or with the directories hard-coded into the macro, but I would need to know the syntax (like .to or .cc) for an attachment. Thank you.

Does it matter which worksheet is open for this to work, or should the relevant worksheet be selected first?

Never mind - I found I had copied the macro into "Sheet 1" instead of "This Workbook".

I really, really like this and I need it - I have a recertification file that I have added this macro to but I cannot get it to run unless I go into the VB & select the "Run" icon. What am I missing? Is this due to a security setting maybe?

can an e-mail be sent if the workbook is NOT opened for alerts about approaching dates

@JAB
' Change the following to .Send if you want to
' send the message without reviewing first
.Display

How can this script be modified to cause the email to be sent automatically?

why can't I change that s "flag Value" to 100%????

Hi, what if I want to send email reminder every ten days before due date will be reached, if reach, and every next ten days for three times? and stop if they already send the project
I also wondering if I can send the email to a lot of people according to which group the project is held, so if a project is from group a, I will send the notification to everyone in group a.
please help me, thank you.

Hi,

This article helps a lots, what if I would like to attach one image in the same email ?

This macro works for me except it does not put the projects name into the email

Amazing stuff worked well for me with some tweaks into this Code. Good work Alan :-)

I could not get this to work until I c hanged the following;

lLastRow = Cells(Rows.Count, 3).End(xlUp).Row

to;
lLastRow = Cells(Rows.Count, 2).End(xlUp).Row


I have never been able to get this to run when the worksheet is opened. I can only get it to run when I manually run it.

Dear Sir - all is well in this tip of sending mails via excel but no SCREENSHOT EXAMPLES given whichw e can relate and get exactly what to do.

It's also quite easy to interface to a Gmail account using the CDO library.

Dear Allan,
In response to your tip about sending e-mail through Excel, and particularly about your line "VBA cannot be easily used to connect with other mail clients.", I would just like to comment that it connects very well also to Lotus Notes, in more or less the same way as it connects to Outlook. On extra bonus with Lotus Notes is that you can choose - programatically - into which folder the mail that you are sending should go. If the folder does not exist, it is created.

Thanks for all your valuable tips.

Bengt

This is beautiful, but I would like to be able to send an sms on the due date, via thesim card in my modem. Thanks if you can point me to it.