Send E-Mail From Outlook If Date Is Overdue In Excel

[excelbytes]

I have a spreadsheet that has a list of due dates in column B. In column D is where the project is marked complete. Column A has the project name. I would like an e-mail sent via Outlook each time the workbook is opened for each project where the date in column B is past today and column D is not marked "Complete". I found this code, but it doesn't seem to generating an e-mail:

Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim lLastRow As Long
Dim lRow As Long
Dim sSendTo As String
Dim sSendCC As String
Dim sSendBCC As String
Dim sSubject As String
Dim sTemp As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

' Change the following as needed
sSendTo = "runninrep@outlook.com"
sSendCC = ""
sSendBCC = ""
sSubject = "Project(s) Past Due!"

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For lRow = 2 To lLastRow
If Cells(lRow, 4) <> "COMPLETED" Then
If Cells(lRow, 2) <= Date Then
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = sSendTo
If sSendCC > "" Then .CC = sSendCC
If sSendBCC > "" Then .BCC = sSendBCC
.Subject = sSubject

sTemp = "Hello!" & vbCrLf & vbCrLf
sTemp = sTemp & "The due date has passed! "
sTemp = sTemp & "for this project:" & vbCrLf & vbCrLf
' Assumes project name is in column B
sTemp = sTemp & " " & Cells(lRow, 1)
sTemp = sTemp & "Please take the appropriate"
sTemp = sTemp & "action." & vbCrLf & vbCrLf
sTemp = sTemp & "Thank you!" & vbCrLf

.Body = sTemp
' Change the following to .Send if you want to
' send the message without reviewing first
.Send
End With
Set OutMail = Nothing

Cells(lRow, 6) = "S"
Cells(lRow, 7) = "E-mail sent on: " & Now()
End If
End If
Next lRow
Set OutApp = Nothing
End Sub

I also found this code:

Option Explicit
Sub SendEmail03()
Dim Date_Range As Range
Dim rng As Range
Set Date_Range = Range("B4:B203")
For Each rng In Date_Range
If rng.Value <= Date Then
Dim Subject, Send_From, Send_To, _
Cc, Bcc, Body As String
Dim Email_Obj, Single_Mail As Variant
Subject = "See Past Due Dates"
Send_From = "runninrep@outlook.com"
Send_To = "runninrep@outlook.com"
Body = "Check file for past due dates"
On Error GoTo debugs
Set Email_Obj = CreateObject("Outlook.Application")
Set Single_Mail = Email_Obj.CreateItem(0)
With Single_Mail
.Subject = Subject
.To = Send_To
.Body = Body
.send
End With
End If
Next
Exit Sub
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub


Sadly, I'm not sure if there is an issue with the code or if I just don't have the connection from Excel to Outlook set up properly. Do you know of any instructions to ensure this is done correctly?

Thanks in advance for any help you can provide.

 

[excelbytes]

So I just found a new twist to this endeavor. It needs to run on a Mac. When it's run on a Mac it generates:

Error 429: Active X component can't create object

In searching, I find that Macs can't run Active X objects, meaning it can't activate the Outlook App: "Set OutApp = CreateObject("Outlook.Application")"

Any way around that?

Here is the current code:

Sub Send_Email()
Dim OutApp As Object, OutMail As Object
Dim lLastRow As Long, lRow As Long
Dim sSendTo As String, sSendCC As String, sSendBCC As String
Dim sSubject As String, sTemp As String

On Error GoTo errHandler
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

' Change the following as needed
sSendTo = "person@email.com"
sSendCC = "person2@email.com"
sSubject = "Project Past Due!"

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
For lRow = 2 To lLastRow
   If Cells(lRow, 4) <> "COMPLETED" Then
      If Cells(lRow, 2) <= Date Then
         Set OutMail = OutApp.CreateItem(0)
         'On Error Resume Next
         With OutMail
            .To = sSendTo
            If sSendCC > "" Then .CC = sSendCC
            If sSendBCC > "" Then .BCC = sSendBCC
               .Subject = sSubject
               sTemp = "Hello!" & vbCrLf & vbCrLf
               sTemp = sTemp & "The due date has passed for this project: " & vbCrLf & vbCrLf
               ' Assumes project name is in column B
               sTemp = sTemp & " " & Cells(lRow, 1) & vbCrLf & vbCrLf
               sTemp = sTemp & " Please take the appropriate action." & vbCrLf & vbCrLf
               sTemp = sTemp & "Thank you!" & vbCrLf
               .Body = sTemp
               ' Change the following to .Send if you want to
               ' send the message without reviewing first
               '.Send
               .Send
           End With
           Set OutMail = Nothing
           Cells(lRow, 6) = "E-mail sent on: " & Now()
       End If
   End If
Next lRow
exitHere:
Set OutApp = Nothing
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Sub

 

[Micron]

It needs to run on a Mac.

Sorry, out of my league now. You'll have to research how to send email from Excel using Mac.

 

[excelbytes]

Micron, understood. Thanks again for all your help.

I'm guessing there is something in the code that is triggering a Mac to also send it for the Summary worksheet name.

Thanks again.

 

[Micron]

Good luck with the Mac issue!

 

[Anakin89]

good day,

I am a very basic user and am trying to find a code to only send to a single email address (located in R1) based on all data in a spread sheet to let a supervisor know before someone returns. I would like this to be sent out -7 days prior to "End Date" in column J. I also need to have the code automatically change the color in (column J) after the email is sent so that it will not resend every time the spread sheet is opened and automatically save after the code completes. Please highlight the areas I need to fill in.

I need the email to read:
"Title"
"Member Name (column E+F) is returning from (column L) on (column J)
Thanks,
NAME
Department

Thanks,
Mitch