Tech Support Guy banner
Cancel

Automated email in excel, driven by due date

4188 Views 59 Replies 3 Participants Last post by  OBP, 
J
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

See less See more
Save
Like
Status
Not open for further replies.
1 - 20 of 60 Posts
O
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?
Save
Like
J
OBP said:
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?
Click to expand...
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.
Save
Like
O
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.
See less See more
Save
Like
J
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"
Rectangle Font Screenshot Software Parallel

Attachments

See less See more
2
Save
Like
O
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.
Save
Like
O
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.
Save
Like
O
This appears to working OK now.

Attachments

Save
Like
J
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.
Save
Like
O
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?
Save
Like
J
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.
Save
Like
O
That is odd, it says that it sent them for all of docs, did it fill in the sent date without sending them?
Save
Like
O
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
See less See more
Save
Like
M
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
See less See more
Save
Like
O
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.
Save
Like
M
Hi,
Attached is the dummy data spreadsheet. the email should be sent to email address specified in Column a, or can it be sent to a specific mail?
Thank you

Attachments

Save
Like
O
The layout is not a problem, the email can be sent to the address in column A or one specified elsewhere, or both.
I notice that there are a lot of dates, which ones will require emails, what order should they be checked in and will the email change regarding each date?
How will you flag up that an email has been sent for a particular date to prevent the VBA from repeatedly sending the same email?
Save
Like
M
Email should be sent for each "valid until" date that is closer then a month from "today". After that we will know that the person need to have annual training or check up and the date will be adjusted accordingly. Repeated email sending is not a problem, at least the email recipient will be forced to do something about it :)
Also the checking order is no issue
Save
Like
O
So what about the email addresses?
Save
Like
M
Lets assume that the emails will be sent to addresses in A Column, so we can easily delete them from there in order to prevent extreme mail receiving if it will be opened by more persons in one day.
Save
Like
1 - 20 of 60 Posts
Status
Not open for further replies.
Tech Support Guy
A forum community dedicated to tech experts and enthusiasts. Come join the discussion about articles, computer security, Mac, Microsoft, Linux, hardware, networking, gaming, reviews, accessories, and more!
Full Forum Listing
Explore Our Forums
Hardware Virus & Other Malware Removal Off Topic Lounge Thread Games & Discussion Networking
Top