The following functions/routines are an automation of an end of day receipt emailing process that formerly would take up to an hour, but now takes less than a minute.
Things to note: I changed the name of some of a variable or two in order to protect the identity of the company that this is being used for. THe vast majority of the variables/objects are uneffected, but several have had to be changed. I am also aware of the ability to change worksheet code names so that they can be utilized like Global Variables, but I am hesistant to change code names for sheets in this specific workbook because there are a lot of other macros that have been written by someone else and i'm not sure how they manipulate the existing worksheet objects. I am confident these worksheet names will never change.
I am open to any and all criticism, especially on how to do things more efficiently and cleanly. I am still fairly new to VBA and i'm looking to write like a professional. I would love to utilize arrays more often, but i'm not quite sure how to search through their contents or how to organize them well. I've only used them to store product codes and things like that to iterate through an array with an index counter. I'd also like some pointers on error handling!
Clarifying the Processes: This code runs off of a main sheet that lists business conducted for the day by client, ReportsByFirmSheet, and generates receipt emails for each client that did business with the company utilizing the sheets. These emails have a general static body that does not change (the to field changes dependent upon the client) and have PDF receipts attached (clients may have multiple receipts throughout the day). ControlPanelSheet is merely the main driving sheet of the workbook where most of the macro execution abilities are stored for client side use. TradesMasterSheet is a big running sheet of raw business data (RepotsByFirmSheet is a less detailed summation of those business transactions). ContactsMaster, which is not defined (because I was able to change the codename for that one) is where all of the email contact information and client specifics are stored.
An improvement I had considered, but was unsure how to implement, was to minimize the iteration through reports by firm to one run by naming and creating multiple email objects and allocating the specific receipts to each mail object rather than repetitively iterating through the sheet and creating emails for one client at a time.
Option Explicit
Public Const EMAIL_BODY As String = "Hello," & "<br><br>" & "Please find today's business receipt's attached. Thank you." & "<br><br>" & "Best Regards," & "<br>"
Public Const PDF_FILE_PATH As String = "X:\Back Office\Receipt Drop File\"
Public Const EXCEL_CONFIRM_FILE_PATH As String = "X:\Back Office\Receipt Drop File\Excel Receipt Drop File\"
Public Const CME_DESIGNATION As String = "_vs._NYMEX"
Public Const ICE_DESIGNATION As String = "_vs._ICE"
Dim FormattedReportDate As String
Dim ReportsByFirmSheet As Worksheet, ControlPanelSheet As Worksheet, TradesMasterSheet As Worksheet
Private Sub SendPdfEmails()
'Sends PDF emails to clients
'Version 2
'Written by Storms Edge
'Project start 3/1/2016
Dim appOutLook As Outlook.Application
Dim outMail As Outlook.MailItem
Dim eeBook As Workbook
Dim firmAlreadyRun As Boolean, isTraderSeparate As Boolean, firmNeedExcelConfirm As Boolean, productSeparatedEmails As Boolean
Dim activeWorkbookName As String, currentFirmName As String, currentTraderName As String, firmEmail As String, firmName1 As String, firmName2 As String, firmName3 As String
Dim lastRowReportsByFirmSheet As Long, lRowContactsMasterSheet As Long, reportsByFirmRowCounter As Long
Application.ScreenUpdating = False
Application.StatusBar = True
activeWorkbookName = ActiveWorkbook.Name
Set eeBook = Workbooks(activeWorkbookName)
Set ReportsByFirmSheet = eeBook.Sheets("ReportsbyFirm")
Set ControlPanelSheet = eeBook.Sheets("Control Panel")
Set TradesMasterSheet = eeBook.Sheets("Trades Master List")
Set appOutLook = CreateObject("Outlook.Application")
On Error GoTo Bail_Out
'Sets Date parameters in Reports by firm and ensures date linkage between reports by firm and control panel by running control panel routine
ReportsByFirmSheet.Cells(1, 2) = ControlPanelSheet.Cells(7, 6)
ReportsByFirmSheet.Cells(2, 2) = ControlPanelSheet.Cells(7, 6)
FormattedReportDate = Replace(Format(Range("printinvdate"), "m/d/yy"), "/", ".")
Call gen_report
'finds last row to create end bound of for loop iteration through Reports By Firm Sheet
lastRowReportsByFirmSheet = ReportsByFirmSheet.Cells(ReportsByFirmSheet.Rows.Count, "A").End(xlUp).Row
'Iterates through reports by firm and steps down each row to capture all firms and generate emails
For reportsByFirmRowCounter = 11 To lastRowReportsByFirmSheet
currentFirmName = ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 5).Value
currentTraderName = ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 6).Value
'Tests to see if firm was already run and subsequently if the emp was already run if annotated that emp is seperate in memory manager area
firmAlreadyRun = FirmDidRun(currentFirmName, currentTraderName, ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 3).Value)
'Skips iteration process and moves to next if firm/trader has already been run
If firmAlreadyRun = True Then GoTo skipIteration
firmEmail = GetFirmEmailInfo(reportsByFirmRowCounter, currentFirmName, currentTraderName, isTraderSeparate, firmNeedExcelConfirm, firmName1, firmName2, firmName3, productSeparatedEmails)
'tests firmEmail for clients who do not receive emailed confirms
If firmEmail = "NO" Then GoTo skipIteration
'Creates new email object
Set outMail = appOutLook.CreateItem(olMailItem)
Call BuildAddressMailItem(outMail, firmEmail, FormattedReportDate)
Call GetPDFConfirms(outMail, firmEmail, firmName1, firmName2, firmName3, currentTraderName, isTraderSeparate, productSeparatedEmails, reportsByFirmRowCounter, lastRowReportsByFirmSheet)
If firmNeedExcelConfirm = True Then
Call GetExcelConfirms(outMail, currentFirmName, firmName1, firmName2, firmName3)
End If
outMail.Display
Call MemoryManager(firmName1, firmName2, firmName3, currentTraderName, ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 3).Value, isTraderSeparate, productSeparatedEmails)
skipIteration:
'resetes traderSeparate Bool/firmNeedExcelConfirm for continued iteration. firmRun bool resets each iteration automatically
isTraderSeparate = False
firmNeedExcelConfirm = False
productSeparatedEmails = False
Next
contactsMaster.Columns(40).ClearContents
contactsMaster.Columns(41).ClearContents
contactsMaster.Columns(42).ClearContents
contactsMaster.Columns(43).ClearContents
MsgBox ("EOD Confirm Emails generated successfully!")
Exit Sub
Bail_Out:
MsgBox ("Error occurred when generating " & currentFirmName & " PDF confirm email. Please verify that customer information is input across all forms and try again....Memory Manager will pick up from last email generated")
End Sub
Private Sub GetExcelConfirms(ByRef outMail As MailItem, ByVal currentFirmName As String, ByVal firmName1 As String, ByVal firmName2 As String, ByVal firmName3 As String)
Dim excelFilePath As String
Dim excelFileTypeDesignation As String
excelFileTypeDesignation = ".xls"
excelFilePath = BuildFileAddress(currentFirmName, , excelFileTypeDesignation)
If Len(Dir(excelFilePath)) <> 0 Then
outMail.Attachments.Add (excelFilePath)
Else
excelFilePath = BuildFileAddress(firmName1, , excelFileTypeDesignation)
If Len(Dir(excelFilePath)) <> 0 Then
outMail.Attachments.Add (excelFilePath)
Else
excelFilePath = BuildFileAddress(firmName2, , excelFileTypeDesignation)
If Len(Dir(excelFilePath)) <> 0 Then
outMail.Attachments.Add (excelFilePath)
Else
excelFilePath = BuildFileAddress(firmName3, , excelFileTypeDesignation)
If Len(Dir(excelFilePath)) <> 0 Then
outMail.Attachments.Add (excelFilePath)
Else
MsgBox ("Unable to locate " & currentFirmName & "'s excel confirm file. Please attach manually...Continuing")
End If
End If
End If
End If
End Sub
Private Sub BuildAddressMailItem(ByRef outMail As MailItem, ByVal firmEmail As String, ByVal reportDate As String)
'Builds email with address in preparation for relevant attachments
Dim signature As String
'Captures email signarture
With outMail
.Display
End With
signature = outMail.HTMLBody
With outMail
.To = firmEmail
.Subject = reportDate & " Trades - Eagle Energy Brokers"
.HTMLBody = "<BODY style=font-size:12pt;font-family:Calibri>" & EMAIL_BODY & Application.UserName & signature & "</BODY>"
End With
End Sub
Private Sub GetPDFConfirms(ByRef outMail As MailItem, firmEmail As String, ByVal firmName1 As String, ByVal firmName2 As String, ByVal firmName3 As String, ByVal initialTraderName As String, ByVal isTraderSeparate As Boolean, ByVal productSeparatedEmails As Boolean, ByVal reportsByFirmCurrentRow As Long, ByVal lastRowReportsByFirmSheet As Long)
'Attaches PDFs to addressed/created emails
Dim reportsByFirmRowCounter As Long
Dim initialProductDesignation As String, currentProductDesignation As String, currentFirmName As String, currentTraderName As String, currentDealID As String, pdfAddress As String, fileType As String
Dim sameFirmBool As Boolean
initialProductDesignation = ReportsByFirmSheet.Cells(reportsByFirmCurrentRow, 3).Value
fileType = ".pdf"
For reportsByFirmRowCounter = reportsByFirmCurrentRow To lastRowReportsByFirmSheet
currentFirmName = ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 5).Value
currentDealID = ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 1).Value
currentProductDesignation = ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 1).Value
currentTraderName = ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 6).Value
'Top level analysis must be same firm..if not...Skip to next row
If currentFirmName <> firmName1 And currentFirmName <> firmName2 And currentFirmName <> firmName3 Then
GoTo skipToNext
Else
'If employees receive separate emails
Select Case isTraderSeparate
Case False
'If different groups receive receipts for different products
Select Case productSeparatedEmails
Case False
pdfAddress = BuildFileAddress(currentFirmName, currentDealID, fileType)
Case True
'Crude and crude products
If Left(initialProductDesignation, 2) = "LO" Or Left(initialProductDesignation, 2) = "OS" Or Left(initialProductDesignation, 2) = "CL" Then
If Left(currentProductDesignation, 2) = "LO" Or Left(initialProductDesignation, 2) = "OS" Then
pdfAddress = BuildFileAddress(currentFirmName, currentDealID, fileType)
ElseIf Left(currentProductDesignation, 2) <> "LN" Or Left(currentProductDesignation, 2) <> "ON" Then
pdfAddress = BuildFileAddress(currentFirmName, currentDealID, fileType)
Else
GoTo skipToNext
End If
'Natural Gas
ElseIf Left(initialProductDesignation, 2) = "LN" Or Left(initialProductDesignation, 2) = "ON" Then
If Left(currentProductDesignation, 2) = "LN" Or Left(currentProductDesignation, 2) = "ON" Then
pdfAddress = BuildFileAddress(currentFirmName, currentDealID, fileType)
Else
GoTo skipToNext
End If
End If
End Select
Case True
If currentTraderName = initialTraderName Then
pdfAddress = BuildFileAddress(currentFirmName, currentDealID, fileType)
ElseIf currentTraderName <> initialTraderName Then
sameFirmBool = IsTraderSameFirm(currentTraderName, firmEmail, currentFirmName)
Select Case sameFirmBool
Case True
pdfAddress = BuildFileAddress(currentFirmName, currentDealID, fileType)
Case False
GoTo skipToNext
End Select
End If
End Select
End If
'Attaches pdf confirm or notifies thet user that a confirm was not found and they need to do so manually later
If pdfAddress <> "Not Found" Then
With outMail
.Attachments.Add (pdfAddress)
End With
Else
MsgBox ("Deal ID " & currentDealID & " pdf confirm was not found for " & currentFirmName & ". Please attach manually...continuing")
End If
skipToNext:
Next
End Sub
Private Function IsTraderSameFirm(traderName As String, firmEmail As String, firmName As String) As Boolean
'Finds separate trader email and compares to current email to find if same distribution
Dim traderFinder As Range, firmFinder As Range
Dim columnCounter As Long
columnCounter = 1
While firmFinder Is Nothing
Set firmFinder = contactsMaster.Columns(columnCounter).Find(firmName)
columnCounter = columnCounter + 1
Wend
Set traderFinder = contactsMaster.Rows(firmFinder.Row).Find(traderName)
If traderFinder Is Nothing Then
IsTraderSameFirm = False
ElseIf traderFinder.Offset(0, 1).Value = firmEmail Then
IsTraderSameFirm = True
Else
IsTraderSameFirm = False
End If
End Function
Private Function BuildFileAddress(ByVal firmName As String, Optional ByVal dealID As String, Optional ByVal fileType As String) As String
'Builds file address and tests for it's existence
Dim formattedFirmName As String, fileAddressProxy As String, dealProxy As String, excelDate As String
Dim dealArray() As String
Dim dealTradesMasterLocation As Range
formattedFirmName = FormatFirm(firmName)
If fileType = ".pdf" Then
'Locates the trade by Deal ID number in tradesMaster list to determine if trade was done on CME or NYMEX. Deal proxy is meant to act as a format holder for dealIDs
If InStr(1, dealID, "-") > 0 Then
dealArray() = Split(dealID, "-")
Set dealTradesMasterLocation = TradesMasterSheet.Columns(2).Find(CLng(Trim(dealArray(0))))
dealProxy = Trim(dealID)
Else
Set dealTradesMasterLocation = TradesMasterSheet.Columns(2).Find(CLng(Trim(dealID)))
dealProxy = Trim(dealID) & "-" & Trim(dealID)
End If
'Determines designation of exchange (CME or ICE or otherwise) and sets address proxy
Select Case TradesMasterSheet.Cells(dealTradesMasterLocation.Row, 6).Value
Case "Clearport"
fileAddressProxy = PDF_FILE_PATH & formattedFirmName & "\" & FormattedReportDate & "_" & dealProxy & "_" & formattedFirmName & CME_DESIGNATION & fileType
Case "ICE"
fileAddressProxy = PDF_FILE_PATH & formattedFirmName & "\" & FormattedReportDate & "_" & dealProxy & "_" & formattedFirmName & ICE_DESIGNATION & fileType
Case "NASDAQ"
End Select
ElseIf fileType = ".xls" Then
excelDate = Replace(Format(Range("printinvdate"), "mm/d/yy"), "/", ".")
fileAddressProxy = EXCEL_CONFIRM_FILE_PATH & "-" & FormatFirm(firmName) & " " & excelDate & Trim(fileType)
End If
'Testing for unfound file addresses...if unfound will boot message to user in attachment function
If Len(Dir(fileAddressProxy)) <> 0 Then
BuildFileAddress = fileAddressProxy
Else
BuildFileAddress = "Not Found"
End If
End Function
Private Function GetFirmEmailInfo(ByVal reportsByFirmRowCounter As Long, currentFirmName As String, ByVal traderName As String, ByRef isTraderSeparate As Boolean, ByRef firmNeedExcelConfirm As Boolean, ByRef firmName1, ByRef firmName2, ByRef firmName3, ByRef productSeparatedEmails As Boolean) As String
'Finds and sets firm names and returns contact information
'Attempts to find firm in contacts master in the first column...upon failed set of object...tries twice more before requesting input from the user
Dim firmFinder As Range, traderFinder As Range
Dim columnCounter As Long
On Error GoTo FatalErrorInGetEmailInfoFunction
columnCounter = 1
'Checks 3 firmname columns for firmname. If not set prompts user for email
While firmFinder Is Nothing
Set firmFinder = contactsMaster.Columns(columnCounter).Find(currentFirmName)
If columnCounter = 3 And firmFinder Is Nothing Then GoTo PromptForEmail
columnCounter = columnCounter + 1
Wend
'Stops execution if firm does not receive email confirms
If IsEmpty(contactsMaster.Cells(firmFinder.Row, 7)) = False Then
GetFirmEmailInfo = "NO"
Exit Function
End If
'Separated emails by product
If IsEmpty(contactsMaster.Cells(firmFinder.Row, 4)) = False Then
productSeparatedEmails = True
If InStr(ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 3), "LN") = 0 Or InStr(ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 3), "ON") = 0 Then
If contactsMaster.Cells(firmFinder.Row, 4) = "Crude Oil:" Then
GetFirmEmailInfo = contactsMaster.Cells(firmFinder.Row, 5)
Else
GetFirmEmailInfo = contactsMaster.Cells((firmFinder.Row + 1), 5).Value
End If
ElseIf InStr(ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 3), "LN") > 0 Or InStr(ReportsByFirmSheet.Cells(reportsByFirmRowCounter, 3), "ON") > 0 Then
If contactsMaster.Cells(firmFinder.Row, 4) = "Natural Gas:" Then
GetFirmEmailInfo = contactsMaster.Cells(firmFinder.Row, 5)
Else
GetFirmEmailInfo = contactsMaster.Cells((firmFinder.Row + 1), 5)
End If
End If
End If
firmName1 = contactsMaster.Cells(firmFinder.Row, 1).Value
firmName2 = contactsMaster.Cells(firmFinder.Row, 2).Value
firmName3 = contactsMaster.Cells(firmFinder.Row, 3).Value
'Checks for separate trader emails.....If cell filled isTraderSeparate = true
'Checks for firm requirement of excel confirms
If IsEmpty(contactsMaster.Cells(firmFinder.Row, 6)) = False Then isTraderSeparate = True
If IsEmpty(contactsMaster.Cells(firmFinder.Row, 8)) = False Then firmNeedExcelConfirm = True
Select Case isTraderSeparate
Case False
GetFirmEmailInfo = contactsMaster.Cells(firmFinder.Row, 5).Value
Case True
'If traderSeparate is true...finds individual email specific to that trader by searching the rest of the row
Set traderFinder = contactsMaster.Rows(firmFinder.Row).Find(traderName)
GetFirmEmailInfo = traderFinder.Offset(0, 1).Value
End Select
Exit Function
PromptForEmail:
GetFirmEmailInfo = InputBox("Firm email not found...Please input email for confirm distribution")
MsgBox ("Please add firm to Contacts Master after completion of Sub to avoid further email contact requests")
firmName1 = currentFirmName
Exit Function
FatalErrorInGetEmailInfoFunction:
GetFirmEmailInfo = "[email protected]"
End Function
Private Function FirmDidRun(ByVal firmName As String, ByVal traderName As String, ByRef productType As String) As Boolean
'Checks memory manager range to see if firm's email has already been generated
Dim firmFinder As Range
Dim traderFinder As Range
Set firmFinder = contactsMaster.Columns(40).Find(firmName)
If firmFinder Is Nothing Then
FirmDidRun = False
ElseIf firmFinder.Offset(0, 2) = "traderS" Then
Set traderFinder = contactsMaster.Columns(41).Find(traderName)
If traderFinder Is Nothing Then
FirmDidRun = False
Else
FirmDidRun = True
End If
ElseIf firmFinder.Offset(0, 3) = "Crude" Then
If InStr(1, productType, "LN", vbTextCompare) > 0 Or InStr(1, productType, "ON", vbTextCompare) > 0 Then
FirmDidRun = False
Else
FirmDidRun = True
End If
ElseIf firmFinder.Offset(0, 3) = "NatGas" Then
If InStr(1, productType, "LN", vbTextCompare) > 0 Or InStr(1, productType, "ON", vbTextCompare) > 0 Then
FirmDidRun = True
Else
FirmDidRun = False
End If
Else
FirmDidRun = True
End If
End Function
Private Function FormatFirm(ByVal nameToTrim As String) As String
On Error Resume Next
nameToTrim = Trim(Left(nameToTrim, 20))
While Right(nameToTrim, 1) = "." Or Right(nameToTrim, 1) = " "
nameToTrim = Left(nameToTrim, Len(nameToTrim) - 1)
Wend
FormatFirm = nameToTrim
End Function
Private Sub MemoryManager(ByRef firmName1 As String, ByRef firmName2 As String, ByRef firmName3 As String, ByRef currentTraderName As String, ByRef productType As String, ByRef isTraderSeparate As Boolean, ByRef productSeparatedEmails As Boolean)
Dim lRowMemoryManagerCol As Long
lRowMemoryManagerCol = contactsMaster.Cells(contactsMaster.Rows.Count, "AN").End(xlUp).Row
contactsMaster.Cells((lRowMemoryManagerCol + 1), 40).Value = firmName1
contactsMaster.Cells((lRowMemoryManagerCol + 1), 41).Value = currentTraderName
If isTraderSeparate = True Then contactsMaster.Cells((lRowMemoryManagerCol + 1), 42).Value = "traderS"
If productSeparatedEmails = True Then
If InStr(1, productType, "LN", vbTextCompare) = 0 And InStr(1, productType, "ON", vbTextCompare) = 0 Then
contactsMaster.Cells((lRowMemoryManagerCol + 1), 43).Value = "Crude"
Else
contactsMaster.Cells((lRowMemoryManagerCol + 1), 43).Value = "NatGas"
End If
End If
contactsMaster.Cells((lRowMemoryManagerCol + 2), 40).Value = firmName2
contactsMaster.Cells((lRowMemoryManagerCol + 3), 40).Value = firmName3
End Sub
gen_reportdoesn't seem to exist \$\endgroup\$