Excel VBA Outlook - Scheduling an email to email contents of a cell from a workbook at specific time of day

Hi Experts

I have a basic performance monitoring sheet that calculates an average percentage based on tasks completed in cell P82

I have used VBA on other files that creates an email from a section of the sheet or by attaching the sheet itself.

Is there a way in which you can schedule an email to be sent from this file that emails the contents of cell P82 at a specific time of the day?

I have read many options using Task Scheduler in conjunction with Batch files but I am novice at best at this set up.

Any advice would be appreciated

J
Ops-Performance-Tracker.xlsm
Jase AlexanderCompliance ManagerAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
You can use Application.OnTime to schedule sending the email with the value from cell P82.

Code is needed in two places: ThisWorkbook and a regular module sheet.

The code in ThisWorkbook schedules the email and (as written) turns that schedule off if you close the workbook. The code in Workbook_Open sets the time to send the email and schedules it. The Workbook_BeforeClose sub turns that schedule off. If you omit the Workbook_BeforeClose sub, the email will be sent even if the workbook is closed--provided that Excel is still running. In such a case, Excel will open the workbook and send the email.
'All of the following code must go in ThisWorkbook

Private Sub Workbook_Open()
WhenToMail      'Determine when the email must be sent
Application.OnTime NextTime, "EmailOnTime"      'Schedule the email
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime NextTime, "EmailOnTime", , False     'Turn the timed email off
On Error GoTo 0
End Sub

Open in new window

The code in the regular module sheet determines when the email must be sent, sends the email and sets it on the docket to be sent at the same time the next day. Note that you will need to edit the values of sText, sRecipient and sSubject in sub EmailOnTime. Sub Mail_Selection_Range_Outlook_Body is a lightly edited version of code posted by Microsoft Excel MVP Ron de Bruin.
'All of the following code must go on a regular module sheet
Public NextTime As Double

Sub WhenToMail()
If NextTime = 0 Then
    NextTime = Date + TimeSerial(17, 30, 0)     'Send mail at 17:30 every day
    If NextTime < Now() Then
        NextTime = NextTime + 1
    End If
End If
End Sub

Sub EmailOnTime()
Dim sText As String, sRecipient As String, sSubject As String
sText = Format(Worksheets("Sheet1").Range("P82").Value, "#.00%")
sText = "The performance on " & Format(Date, "mmm d, yyyy") & " was " & sText
sRecipient = "byundt@myISP.com"
sSubject = "Today's performance"
Mail_Selection_Range_Outlook_Body sText, sRecipient, sSubject   'Send the email
NextTime = NextTime + 1     'Next email same time, a day later
Application.OnTime NextTime, "EmailOnTime"      'Schedule next email
End Sub

Sub Mail_Selection_Range_Outlook_Body(sText As String, sRecipient As String, sSubject As String)
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object

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

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = sRecipient
        .CC = ""
        .BCC = ""
        .Subject = sSubject
        .HTMLBody = sText
        .Send   'or use .Display
    End With
    On Error GoTo 0

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

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Open in new window

Ops-Performance-TrackerQ29097936.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Steve KnightIT ConsultancyCommented:
How is this sheet used, is it left open all day on a PC, is it opened by multiple people to view etc?

An alternative approach and possibly easier option if the spreadsheet is not necessarily being opened or guarantee that excel is being left open or that Outlook is available on a PC would be that when you have the spreadsheet open and/or close it periodically write that information to a text file on a shared drive and then you can pick that up from a simple scheduled job using a tool like BLAT or VBScript.

That could be as simple as triggering the spreadsheet to write a file like this... e.g. this could write a text file to use as an email body that can be picked up and emailed at a set time regardless of whether excel is running or not.

dim f as integer
f=freefile
Open "\\server\shared\performance\email-body.txt" for output as #f
  print #f,"This is the information from the performance monitoring in " & activeworkbook.name
  print #f,""
  print #f, "Details: " & format(range("P82").value,"0.0%")
  print #f,""
  print #f, "Info last updated at " & Now & " and sent from computer '" & environ("COMPUTERNAME") & "' by user '" & environ("USERNAME") & "'"
close #f

Open in new window


Then you can make a VBScript file like SendEmail.vbs and schedule that to run using task scheduler -- double click to run it to test it - need to customise the mail server and email address lines and point it a the text file made above.

Const MailServer = "12.34.56.78" ' Mail Server to use for SMTP
Const Sender = "logs@somedomain.com" 
Const Subject="Subject line"
Const Recipient="logs@somedomain.com"
Const BodyFile ="\\server\shared\performance\email-body.txt"

Body =""
on error resume next
Rem Get body of message
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
  Set f = fso.OpenTextFile(BodyFile, ForReading)
    Body = f.ReadAll
  f.Close
Set f = Nothing
Set fso = Nothing

Set objEmail = CreateObject("CDO.Message")

objEmail.From = Sender
objEmail.To = Recipient
objEmail.Subject = Subject
objEmail.Textbody = Body

objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = MailServer
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update()
objEmail.Send

Open in new window

0
Jase AlexanderCompliance ManagerAuthor Commented:
Thanks both

You have given me two amazing options - thank you for your time and much appreciated as always

J
0
Steve KnightIT ConsultancyCommented:
No problem, as always lots of ways of doing the same thing!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook 2013

From novice to tech pro — start learning today.