Visit my Youtube Channel
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:
- the csv file hasn’t refreshed.
- an error in the CreateInvReportCopy function which returns a False.
- the GetEmail id function returns a blank string.
- 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