Schedule A Daily Report To Be Sent By Outlook Email Using Excel VBA [Project]

Home

Note: This webpage is designed to accompany the Youtube video posted below. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

Here, we will go through the process of creating a macro that refreshes our dataset and sends our a daily report to a list of recipients using Excel VBA. The procedure itself will get triggered when we open the macro file. To set this as a daily scheduled task, we will create a task in the Windows Task scheduler that will be triggered daily at a certain time. In this blog though, we will just go through the coding bit. Rest of the information is available in the above video.

Main Sub Procedure

The sFolderPath is the parent directory which is set as a constant. You can replace with your own folder path. We will need a sub-folder within the parent directory called Archive, where a copy of the Invoice report will get saved. There is also, a sub folder called Data where the csv file is placed.

The macro will first check the date on the csv file, which will tell us when it was last refreshed or saved by IT. As per our process, we will schedule the macro to run after the daily refresh of the csv file. So, if date on the csv file isn’t equal to today, we will exit the macro as this indicates that the csv wasn’t refreshed today.

Once we have validated that the data source is current, we will proceed to the function where we create a copy of the invoice report. This function will refresh the template file which is connected to the csv file and save a copy with today’s date in the file name.

Next, we will get the email ids of all the recipients which is stored in a separate file. 

Lastly, we will send our email with the report copy attached.

Option Explicit
Public Const sFolderPath As String = "C:\Youtube\Outlook Project 01\Project Space\"

Sub CreateAgedInvoiceReport()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim sErrorReason As String
Dim sSourceFileName As String, sDestFileName As String, sCSVFileName As String
sSourceFileName = sFolderPath & "Aged Invoice Template.xlsx"
sDestFileName = sFolderPath & "Archive\" & "AgedInvoice_" & Format(Date, "yyyymmdd") & ".xslx"
sCSVFileName = sFolderPath & "Data\" & "Aged_Invoice_Details.csv"

Dim dResult As Date
dResult = FileDateTime(sCSVFileName)
dResult = Format(dResult, "Short Date")
If dResult <> Date Then
    sErrorReason = "csv file hasn't refreshed"
    Call SendErrorEmail(sErrorReason)
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub
End If

If Not CreateInvReportCopy(sSourceFileName, sDestFileName) Then
    sErrorReason = "Couldn't create a copy"
    Call SendErrorEmail(sErrorReason)
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub
End If

Dim sBody As String, sTo As String, sSubject As String, sAttach As String

sBody = "Good Morning, <br><br>" & _
        "Aged Invoice Summary Pivot attached for " & Format(Date, "dd-MMM-yyyy") & ".<br><br>" & _
        "Regards,"
sTo = GetEmail()

If sTo = "" Then
    sErrorReason = "Email Aborted due to No Trigger in Email List or No Email Id"
    Call SendErrorEmail(sErrorReason)
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub
End If

sSubject = "Aged Invoice Summary Report"
sAttach = sDestFileName

If Not Send_Email_Single_Attach(sTo, sSubject, sBody, sAttach) Then
    sErrorReason = "Couldn't send email"
    Call SendErrorEmail(sErrorReason)
    Else
    'MsgBox "File mailed successfully"
End If

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

Function: Send Email to Users

This function will take the parameters To, Subject, Body and Attachment File. It will return a True, if no error is encountered during execution. If there is an error, then the Go To statement will get triggered and the code will jump to line label SystemErrorHandler and the function will return a False.

Private Function Send_Email_Single_Attach(sfTo As String, sfSubject As String, sfBody As String, sfAttach As String) As Boolean
'   Remember to add the Outlook Reference
'   Goto Tools -> Reference and select the Outlook Object Library
'   Version selected in this project was Microsoft Outlook 16.0 Object Library

Dim oApp As Outlook.Application
Set oApp = New Outlook.Application
Dim oMail As Outlook.MailItem
Set oMail = oApp.CreateItem(olMailItem)

On Error GoTo SystemErrorHandler
With oMail
    .Display
    .To = sfTo
    .CC = ""
    .BCC = ""
    .Subject = sfSubject
    .HTMLBody = sfBody & .HTMLBody
    .Attachments.Add sfAttach
    '.Display
    .Send
End With
Send_Email_Single_Attach = True
Exit Function
SystemErrorHandler:
Send_Email_Single_Attach = False
End Function

Function: Create Invoice Report

This function will take two parameters: the source file and the destination file. The source file is the template file which is connected to the data source and contains the pivot table as well. For the first part of this function, we will open the source file, refresh the data connection and refresh the pivot table. Make note of the statement .BackgroundQuery = False. This will allow the macro to wait till the connection query has finished refreshing. It’s especially handy if the refresh is expected to take long.

Once the refreshes are complete, the source file will be saved with the file name as the destination file. We don’t need the source file anymore, and we can proceed to open this newly saved destination file. We will  clean up the file by deleting any existing connections or queries in it. Once done, the destination file is saved and closed. It is now, ready to be sent as an attachment,

Private Function CreateInvReportCopy(sfSourceFileName As String, sfDestFileName As String) As Boolean

If Dir(sfDestFileName) <> "" Then
    Kill sfDestFileName
End If

On Error GoTo SourceErrorHandler
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(sfSourceFileName)

Dim Conn As WorkbookConnection
For Each Conn In wbSource.Connections
    Conn.OLEDBConnection.BackgroundQuery = False
    Conn.Refresh
Next

Dim pvc As PivotCache
For Each pvc In wbSource.PivotCaches
    pvc.Refresh
Next

wbSource.Save
wbSource.SaveAs sfDestFileName
wbSource.Close savechanges:=False

On Error GoTo DestErrorHandler
Dim wbDest As Workbook
Set wbDest = Workbooks.Open(sfDestFileName)

Dim i As Long

For i = wbDest.Connections.Count To 1 Step -1
    wbDest.Connections.Item(i).Delete
Next i
For i = wbDest.Queries.Count To 1 Step -1
    wbDest.Queries.Item(i).Delete
Next i
wbDest.Save
wbDest.Close savechanges:=False

CreateInvReportCopy = True
Exit Function
SourceErrorHandler:
wbSource.Close savechanges:=False
CreateInvReportCopy = False
DestErrorHandler:
wbDest.Close savechanges:=False
CreateInvReportCopy = False
End Function

Function: Get Email Ids

Here, we will populate all the email ids that we want to send the report to, into a single string; which will then be passed into the Send Email function. Our list of emails is saved in a separate file, in the worksheet AgedInvoice_Em. A For Loop will iterate from the second row to the end, and place every email id into our string variable separated by a comma. This gives us one extra comma in the end, which we will remove once the loop is completed.

Also, note the worksheet SendFile. This is a safeguard. Our macro file is designed to trigger the entire procedure and send our email, when the file is opened. If we want to just open the file to change the code, then we need to open it the right way (i.e. open it through an existing Excel instance or by hitting Shifting and opening the file directly). If we don’t, then we run the risk of firing off the macro.

Since I am making the assumption that this is a report to be sent out to our senior execs, we would rather want to avoid any embarrassment. So, I have included another safeguard to prevent our macro from accidently firing off, if we don’t want it to. For this, we need to enter the value No into cell B2 on sheet SendFile, or leave the cell blank. If we do, then the function will return a blank string as the To string for the email ids and the main sub-procedure will not proceed further and exit the sub. 

Private Function GetEmail() As String

Dim wbEm As Workbook
Dim wsEm As Worksheet, wsSf As Worksheet

Set wbEm = Workbooks.Open(sFolderPath & "EmailList.xlsx")
Set wsEm = wbEm.Sheets("AgedInvoice_Em")
Set wsSf = wbEm.Sheets("SendFile")

Dim sTo As String
If wsSf.Range("b2").Value = "No" Or wsSf.Range("b2").Value = "" Then
    sTo = ""
    GoTo Line1
End If

Dim lrow As Long
lrow = wsEm.Range("A1").CurrentRegion.Rows.Count

Dim i As Long
For i = 2 To lrow
    sTo = sTo & wsEm.Range("A" & i).Value & ";"
    If i = lrow Then
        sTo = Left(sTo, Len(sTo) - 1)
    End If
Next i
Line1:
    wbEm.Close savechanges:=False
    GetEmail = sTo
End Function

Function: Send Error Email

If we encounter an error while running the main sub, our error handling will kick in and we will exit the sub. But, before we do, we will send ourselves an error email which tells us what went wrong. The error email can get generated at four instances:

1. the csv file hasn’t refreshed.
2. an error in the CreateInvReportCopy function which returns a False.
3. the GetEmail id function returns a blank string.
4. an error in the Send_Email_Single_Attach function which returns a False.

Private Sub SendErrorEmail(sfErrorReason As String)

Dim oApp As Outlook.Application
Set oApp = New Outlook.Application
Dim oMail As Outlook.MailItem
Set oMail = oApp.CreateItem(olMailItem)

On Error Resume Next
With oMail
    .Display
    .To = "[email protected]"
    .CC = ""
    .BCC = ""
    .Subject = "Failure to Deliver Aged Invoice Report"
    .HTMLBody = sfErrorReason
    '.Display
    .Send
End With

End Sub