Automated email in excel, driven by due date

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

jaime9

Thread Starter
Joined
Oct 18, 2017
Messages
5
Hi everybody,

First time poster. I currently have 9 tabs open and hours of researching trying to figure this out. I can say I'm more educated now with excel than I was this morning. Very powerful software.

I seen current thread that were very close to what I need but was unsuccessful with achieving what I needed.

I'm trying to set an email reminder sent to my team when a task has not been completed (Column D) by the due date (Column C) and some indicator on column H when completed. It would be most ideal if the subject had the part number "123453 Rev 06 Doc Control Update" and body said Dear Andy(Task Owner) reminder, please update documentation related to your department. Thanks.

I currently have a macro for 'Task completed' be filled in a green color when complete. I'll copy and paste below what i currently have. I know this is probably a long shot but I am getting somewhat stressed and losing hope with this, please please please help. function is more critical for me then the looks, if i have to move some cells around I don't mind one bit.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("D2:D100")) Is Nothing Then
        With Target(1, 2)
        .Value = Date & " " & Time
        .EntireColumn.AutoFit
        End With
    End If
End Sub

Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With
Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lRow
toDate = Replace(Cells(i, 3), ".", "/")
  If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 7 Then
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)
        toList = Cells(i, 4)    'gets the recipient from col G
        eSubject = "Document Control Status update "
        eBody = "Reminder," "Please update your project status."
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        .bodyformat = 1
        '.Display   ' ********* Creates draft emails. Comment this out when you are ready
        .Send     '********** UN-comment this when you  are ready to go live
        End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column H"
End If
Next i
ActiveWorkbook.Save
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub
 

Attachments

Last edited:

OBP

Joined
Mar 8, 2005
Messages
19,895
You have obviously already done a lot of work on this, but you have failed to tell us what is wrong with the code that you have.
One thing I never use is "On Error resume next" or "On Error GoTo 0" as this kind of error handling may not provide any useful information and could end up being stuck in a loop.
So what does and doesn't work in the code?
 

jaime9

Thread Starter
Joined
Oct 18, 2017
Messages
5
You have obviously already done a lot of work on this, but you have failed to tell us what is wrong with the code that you have.
One thing I never use is "On Error resume next" or "On Error GoTo 0" as this kind of error handling may not provide any useful information and could end up being stuck in a loop.
So what does and doesn't work in the code?
Shoot sorry. I came across this code on this site and decided work off of it because more or less is what I need. I tried editing to replace the columns in the code with the way my excel form is arranged until i came to the final conclusion that I barely know what Im looking at, so i just copied the original code without any changes in hopes someone could help me adjust to my excel sheet. I'm currently trying to find the original thread where i got the code from. Thanks for replying, any help is greatly appreciated.
 

OBP

Joined
Mar 8, 2005
Messages
19,895
OK, I wrote some code for emailing that didn't use date here.
https://forums.techguy.org/threads/...o-send-automatic-emails.1197123/#post-9418580

But back to your problem, the part of code that does the work is this line
toDate = Replace(Cells(i, 3), ".", "/")
it sets the toDate to the value held in cell(i,3), i being the Row and 3 being the Column, ie Column C.
Note that it is expecting the date to be in the format dd.mm.yyyy which it changes to dd/mm/yyyy
So is your date in the "." format or already in the "/" format.

if it is the "." why doesn't that work for you?
you can test what toDate returns by adding a line after toDate = Replace(Cells(i, 3), ".", "/")
msgbox toDate
and it will give you a system message with the value of todate in it.
 

jaime9

Thread Starter
Joined
Oct 18, 2017
Messages
5
thank you for the info, changed date to read dd.mm.yyyy

screenshot, and updated excel attached.

I am getting the attached error that reads "compile error"Capture.JPG
 

Attachments

OBP

Joined
Mar 8, 2005
Messages
19,895
That is because you have changed all of the "i" counter references to "E" except the first which is
For i = 1 to lrow
if you cahnge it to
For E = 1 to lrow
it should remove that error.
But why did you change it?
I think I will take a look at your Worksheet.
 

OBP

Joined
Mar 8, 2005
Messages
19,895
OK, the layout of your worksheet creates certain problems, in particular the Heading Rows and gaps between data.
The code is expecting find a Date in Column C and they are not dates, so it creates an error.
I will have to rewrite the code to allow for this.
 

jaime9

Thread Starter
Joined
Oct 18, 2017
Messages
5
wow thanks!!! That was fast.

Can the code see if task is already marked complete to not send out an email? Only send out to individuals that have not completed their task and are past the Due Date. Once the email draft is made can the email be sent out automatically?

Right now I get the email draft to pop up with correct message(which is mind blowing to me), but still pops up even after I mark the task complete. How can I get this code to run in intervals (daily)?

Thank you!!! this is cool stuff.
 

OBP

Joined
Mar 8, 2005
Messages
19,895
How did you mark it as Complete?
It should only be sending emails without a "Y" in Column D.
To send the email automatically remove the ' from the front of this line
'.Send
Shouldn't the email contain the Document and Revision, the first one being 320183-04 Rev B?
 

jaime9

Thread Starter
Joined
Oct 18, 2017
Messages
5
I think i just got so pumped to see the emails being created after running that I didn't clarify myself correctly.....So yes it should not send to "Y"(my mistake :)

I removed the ' and emails are sent out. thanks!

yes having the doc and rev on the emails would be really convenient.

right now the emails only get sent from the last doc/rev number 322322-01 Rev. B and completely disregards the previous sets of groups.
 

OBP

Joined
Mar 8, 2005
Messages
19,895
That is odd, it says that it sent them for all of docs, did it fill in the sent date without sending them?
 

OBP

Joined
Mar 8, 2005
Messages
19,895
Here is the new code that places the Doc Number in the Subject line, added or changed code in bold.

Dim lRow As Long, objOutlook As New Outlook.Application, objMessage As MailItem
Dim E As Long, docno As String
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
On Error GoTo errorcatch

'With Application
' .ScreenUpdating = False
' .EnableEvents = False
' .DisplayAlerts = False
'End With
Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For E = 4 To lRow
If Not IsNull(Cells(E, 3)) And Cells(E, 2) = "" Then docno = Cells(E, 3)
'MsgBox E & " - " & docno & " " & Cells(E, 3) & " " & Cells(E, 2)
If Mid(Cells(E, 3), 3, 1) = "/" Then
toDate = Cells(E, 3)
If Cells(E, 4) <> "Y" And toDate - Date <= 5 Then
Set objMessage = objOutlook.CreateItem(olMailItem)
toList = Cells(E, 7) 'gets the recipient from col G
eSubject = "Document " & docno & " is due for review on " & Cells(E, 3)
eBody = "Dear " & Cells(E, 6) & ", " & vbCrLf & vbCrLf & "Please update your project
status."
With objMessage
.To = toList
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
.Display ' ********* Creates draft emails. Comment this out when you are ready
'.Send '********** UN-comment this when you are ready to go live
End With
Set objOutlook = Nothing
Set objMessage = Nothing
Cells(E, 8) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column H"
End If
End If
Next E
ActiveWorkbook.Save
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
Exit Sub
errorcatch:
MsgBox Err.Description
 
Joined
Oct 3, 2017
Messages
22
Good morning,
I have a question:
I am trying work on the code to send the email when the due date is 30 days from today. The problem is, that cells with dates are not in a column, but in the row, and are not adjacent to each other. Is there a way to do that?
The dates are in the columns K, N, R, U, X, etc.
And as a bonus, some cells are empty.
I have no idea how to do that. please help :)

Adam
Please find code below

Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With

Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row

For i = 2 To lRow
toDate = Replace(Cells(i, 3), ".", "/")
If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 30 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

toList = Cells(i, 4) 'gets the recipient from col D
eSubject = "Due date " & Cells(i, 2) & " propadne dne " & Cells(i, 3)
eBody = "Pracovník " & Cells(i, 1) & vbCrLf & vbCrLf & "is due date."

On Error Resume Next
With OutMail
.To = toList
.CC = ""
.BCC = ""
.Subject = eSubject
.Body = eBody
.bodyformat = 1
'.Display ' ********* Creates draft emails. Comment this out when you are ready
.Send '********** UN-comment this when you are ready to go live
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Cells(i, 5) = "Mail sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i

ActiveWorkbook.Save

With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
 

OBP

Joined
Mar 8, 2005
Messages
19,895
Please see my comments about Error trapping in post #2 and see my code on better error trapping.

Can you supply a workbook with some dummy data in it to show the layout or a screenshot of it?
Note personal data should not be included.
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts

Members online

Top