Sending Emails from Outlook using VBA in Excel

In case you didn't already know, I always enjoy reading articles about interop between Outlook and Excel using VBA code. So I read the recent guest post on Chandoo's site with interest. I downloaded the sample workbook to study the code, and I suggest you do the same.

Here's my version of Vijay's ExportEmail procedure. It may not be shorter but it has some advantages we'll discuss shortly.

Sub ExportEmail()

  On Error GoTo ErrorHandler

  Dim currentFilePath As String
  Dim currentWorkbook As Excel.Workbook
  Dim currentFolder As String
  Dim currentFileName As String
  Dim currentDate As Date
  Dim fileExt As String
  Dim newWorkbook As Excel.Workbook
  Dim newFilePath As String
  Dim newFileName As String
  Dim emailSheet As Excel.Worksheet
  Dim olApp As Object ' Outlook.Application
  Dim emailMsg As Object ' Outlook.MailItem
  Dim toField As String
  Dim ccField As String
  Dim bccField As String
  Dim toRange As Excel.Range
  Dim ccRange As Excel.Range
  Dim bccRange As Excel.Range
  Dim toRecips As Variant
  Dim ccRecips As Variant
  Dim bccRecips As Variant
  Dim toRecip As Object ' Outlook.Recipient
  Dim ccRecip As Object ' Outlook.Recipient
  Dim bccRecip As Object ' Outlook.Recipient
  Dim i As Long

  Const olMailItem As Long = 0
  Const REPORT_NAME As String = "Customer Service Dashboard Report"

  ' **************************************************
  ' get basic info about existing workbook
  ' **************************************************
  Set currentWorkbook = ActiveWorkbook
  currentFilePath = currentWorkbook.FullName
  ' assume current workbook is saved
  currentFileName = Mid$(currentFilePath, _
    InStrRev(currentFilePath, "\") + 1)
  currentFolder = Left$(currentFilePath, _
    InStrRev(currentFilePath, currentFileName) - 1)
  currentDate = Date

  ' **************************************************
  ' optimizations
  ' **************************************************
  With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .StatusBar = "Creating Email and Attachment for " & _
       Format(currentDate, "Long Date")
  End With

  ' **************************************************
  ' create new workbook
  ' **************************************************
  currentWorkbook.Sheets(Array("Cover", _
     "Interval Data", "rawData")).Copy
  Set newWorkbook = ActiveWorkbook
  newWorkbook.Sheets("rawData").Visible = False

  ' assume current dir
  fileExt = GetFileType(currentFileName)
  newFileName = REPORT_NAME & " " & _
                Replace(Format(currentDate, "Long Date") & _
       " " & Format(Time, "Long Time"), ":", "_") & fileExt
  newFilePath = currentFolder & newFileName

  On Error Resume Next
  Kill newFilePath
  On Error GoTo ErrorHandler
  newWorkbook.Close True, newFilePath

  ' **************************************************
  ' grab emails from Email sheet in original workbook
  ' **************************************************
  Set emailSheet = currentWorkbook.Sheets("Email")

  ' next line will throw error we should be handling at runtime
  On Error Resume Next
  Set toRange = GetRange(emailSheet, "ToEmails")
  Set ccRange = GetRange(emailSheet, "CcEmails")
  Set bccRange = GetRange(emailSheet, "BccEmails")
  On Error GoTo ProgramExit

  If toRange Is Nothing Then
    MsgBox "There is nobody in the To: field. " & _
     "Add at least one email address in the To: column and try again."
    GoTo ProgramExit
  End If

  With toRange
    If .Cells.Count > 1 Then
      toField = Join(Application.Transpose(.Value), ";")
    Else
      toField = .Value
    End If
  End With

  If Not ccRange Is Nothing Then
    With ccRange
      If .Cells.Count > 1 Then
        ccField = Join(Application.Transpose(.Value), ";")
      Else
        ccField = .Value
      End If
    End With
  End If

  If Not bccRange Is Nothing Then
    With bccRange
      If .Cells.Count > 1 Then
        bccField = Join(Application.Transpose(.Value), ";")
      Else
        bccField = .Value
      End If
    End With
  End If

  ' **************************************************
  ' grab Outlook and create email
  ' **************************************************
  Set olApp = GetOutlookApp
  If olApp Is Nothing Then
    MsgBox "Could not start Outlook."
    GoTo ProgramExit
  End If

  Set emailMsg = olApp.CreateItem(olMailItem)

  With emailMsg
    If InStr(toField, ";") = 0 Then  ' one recipient, add it directly
      Set toRecip = .Recipients.Add(toField)
      toRecip.Type = olTo
    Else  ' tokenize string and loop through it to add recipients
      toRecips = Split(toField, ";")
      For i = LBound(toRecips) To UBound(toRecips)
        Set toRecip = .Recipients.Add(toRecips(i))
        toRecip.Type = olTo
      Next i
    End If

    If InStr(ccField, ";") = 0 Then  ' one recipient or none
      If Len(ccField) > 0 Then ' one recipient
        Set ccRecip = .Recipients.Add(ccField)
        ccRecip.Type = olCC
      End If
    Else  ' tokenize string and loop through it to add recipients
      ccRecips = Split(ccField, ";")
      For i = LBound(ccRecips) To UBound(ccRecips)
        Set ccRecip = .Recipients.Add(ccRecips(i))
        ccRecip.Type = olCC
      Next i
    End If

    If InStr(bccField, ";") = 0 Then  ' one recipient or none
      If Len(bccField) > 0 Then ' one recipient
        Set bccRecip = .Recipients.Add(bccField)
        bccRecip.Type = olBCC
      End If
    Else  ' tokenize string and loop through it to add recipients
      bccRecips = Split(bccField, ";")
      For i = LBound(bccRecips) To UBound(bccRecips)
        Set bccRecip = .Recipients.Add(bccRecips(i))
        bccRecip.Type = olBCC
      Next i
    End If
    
    .Subject = Replace(Left$(newFileName, _
       InStrRev(newFileName, fileExt) - 1), "_", ":")
    .Body = "Hello," & vbCrLf & vbCrLf & _
            "The attached file is the most current " & REPORT_NAME & "."
    .Attachments.Add newFilePath
    .Display
  End With

ProgramExit:
  With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .StatusBar = False
  End With
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit
End Sub
Function GetFileType(fileName As String) As String
' get file extension
  GetFileType = Mid$(fileName, InStrRev(fileName, "."))
End Function
Function GetOutlookApp() As Outlook.Application
  On Error Resume Next
  Set GetOutlookApp = CreateObject("Outlook.Application")
End Function
Function GetRange(wksheet As Excel.Worksheet, _
     rangeName As String) As Excel.Range
  On Error Resume Next
  Set GetRange = wksheet.Range(rangeName)
End Function

In order to determine the customer dashboard's current folder and filename, I use the FullName Property. This property can be easily parsed to determine the folder and filename. Accessing multiple properties of a single object is accomplished using With blocks. This is a well known best practice.

To get the file extension, we parse the filename. This way, the workbook can be saved in Excel 2003 format and the code will work without modification. The procedure will automatically adjust to either .xls or .xlsm.

To build a string for the new workbook, I use the settings of the local computer to determine how to display the date. Hardcoded strings (like "mm-dd-yyyy") are hopelessly optimistic because they assume that the user wants the date formatted exactly like that. I am working to eliminate this kind of code from my website.

Use Native Methods

Since we incorporate the date AND time into the new workbook's filename, it is highly unlikely to encounter duplicates. However, in the interest of demonstrating a better way to delete files, we go ahead and delete the existing workbook (if any). We do this by simply attempting to delete the file.

The code we are presented actually checks if the file exists before attempting to delete it. I'm afraid I don't see the point. I suggest you simply attempt to delete the file using the Kill method with On Error Resume Next, since either way we get what we want (the file exists and is deleted, or it didn't exist beforehand).

VBA includes several native methods for working with files: we can use Dir to check if a file or folder exists, and Kill or RmDir respectively to delete them. AFAIK, these are built-in methods which common sense tells me have to be at least as fast as, if not faster, than FSO simply by avoiding the overhead of instantiation. Unfortunately, the code invokes FSO (FileSystemObject) over native methods, but then instead of committing fully to FSO (by using the existing CreateFolder Method) it uses MkDir.

Avoid Loops

Instead of looping through a worksheet range, I read the entire To, Cc, and Bcc email addresses into arrays. First I name the three email ranges as follows:

• ToEmails: =OFFSET(Email!$A$1,1,0,COUNTA(Email!$A:$A)-1,1)
• CcEmails: =OFFSET(Email!$B$1,1,0,COUNTA(Email!$B:$B)-1,1)
• BccEmails: =OFFSET(Email!$C$1,1,0,COUNTA(Email!$C:$C)-1,1)

These dynamic ranges automatically expand and contract as email addresses are added or removed. The only assumption made by the code is that the email addresses are aligned vertically. I could have easily added some checks to the Transpose method, making my code fully independent of the worksheet configuration of the email addresses. I could have also put the code into its own function and returned the email addresses to the ExportEmail procedure, but due to time constraints I can't fully optimize it as much as I'd like.

I firmly believe that programming code should be as abstract and reusable as possible. I understand that sometimes hardcoding or coupling is unavoidable. I do this myself all the time, when I'm in a hurry and can't be bothered. However, this type of code simply should not be shared, as it is too localized (as they say on Stack Overflow).

I recognize that my parsing method may seem a bit awkward, but it accomplishes my goal of limiting interaction between VBA and Excel. I make one pass to pick up the email addresses.

Use Late Binding

Early binding is something I almost never do, except when I'm writing code and forget a method or a parameter, and I've worked to remove it entirely from this site. I set the reference, declare the object and use it, then quickly switch back to late binding. I even do this with code I have no intention of sharing. It's just a habit I've developed while writing code for this blog which has spilled over into my offline life.

Unfortunately, the workbook comes with an early bound reference to Outlook 14.0. I have Excel 2010 but Outlook 2003 (version 11.0), what happens is that the reference is listed as "MISSING" and I have to fix it manually. This is a nuisance. How much better to use a late bound reference so this issue simply disappears (as Ken Puls pointed out). With a late bound reference, the code will always point to whatever version of Outlook exists on the local computer. You will never need to ask your users to make adjustments to their VBA Project references, nor will it require any code changes. Flexibility is the goal here.

Declare First

I group all my declarations at the top of a procedure, and I make sure I explicitly declare the type of each variable even if it is Variant. I understand this saves a few keystrokes (and possibly a few bytes), but for me it is a good habit to develop. And, variables should be declared with as narrow a scope as possible. Variants that are only used to hold Strings, should be declared As String.

I use easily readable variables that tell me what they are intended to do or what type of object they are representing. I've stopped using prefixes (especially ones that don't serve any ancillary purpose) because they are a distraction. I can easily check the data type of any variable by clicking it and pressing Shift+F2 (and jump back to where I was using Ctrl+Shift+F2). Knowing the VBA IDE's built-in methods for checking variable type is critical to advancing one's skills.

Streamline Your Logic

Where possible, code should be optimized to avoid needless duplication. For example, the following two lines are found three times in the original code:

newWB.SaveAs Filename:=xPath, FileFormat:=xlOpenXMLWorkbook, 
  Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
   , CreateBackup:=False
Application.ActiveWorkbook.Close

A careful reading of the help section on SaveAs reveals that none of these parameters are required. Of course we want to choose the filename, but the FileFormat parameter in particular is unnecessary. For new workbooks, the FileFormat parameter defaults to the format of the version of Excel being used. By not specifying the format, we again free the code to be used in any workbook, not just 2007+. If we use this code in a 2003 workbook, it will need to be adjusted. By removing this parameter, we make our code more flexible.

This code is placed into an If statement that takes different actions depending on whether the destination folder and/or file exists. In air code it looks something like

If FolderExists Then
  If FileExists Then
    DeleteFile
    SaveAs
    Close
  Else
    SaveAs
    Close
  End If
Else
  MkDir
  SaveAs
  Close
End If

Note that the SaveAs and Close actions are taken regardless of the outcome of the outer and inner If statements. In other words, no matter what we do, we want to save and close the newly created workbook. I'm not sure why this code is included in every possible branch of the If statement. The only statements that belong inside an If statement are the ones that actually depend on the outcome of the expression being evaluated by the If statement. Therefore, we could simply write

If FolderExists Then
  If FileExists Then
    DeleteFile
  End If
Else
  MkDir
End If
SaveAs
Close

We can shorten this even further, because the Workbook.Close Method allows you to simultaneously save the file and specify the filename while closing.

If FolderExists Then
  If FileExists Then
    DeleteFile
  End If
Else
  MkDir
End If
Close true, filename

Furthermore, I'm puzzled as to why Application.ActiveWorkbook is used here when we have a reference to the ActiveWorkbook Object (the variable newWB).

Conclusion

I hope my code has been useful to you. I've tried to incorporate several best practices, including:

• Encapsulate reusable methods
• Analyze code logic to write efficient code
• Use native methods where possible
• Loop through arrays, not ranges
• Late binding promotes flexibility

This leads to better habits and more efficient code. Any more optimizations I missed?