The VBA Guide To Sending Excel Attachments Through Outlook

Quickly Emailing Your Spreadsheets

I absolutely love using the Email As Attachment functionality provided by Excel. It’s great for quickly sending one-off data requests to someone throughout the day. The only thing I dislike about this built-in feature is the lack of customization as I find myself repeatedly making the same changes over and over again.

This annoyance inspired me to create a couple of VBA macros allowing me to add a little more functionality to Microsoft’s Email As Attachment idea.

For one, I hate not being able to name the attached file. I can’t tell you how many times I’ve attached a file named “Book1.xlsx” to someone. I also like to add some sort of message in the email such as “Please see attached” or “Attached is your requested data“. Having to type this out every time can be a bit annoying.

So I would like to share with you what I use to email my Excel workbooks and worksheets as attachments. Now, this code was intended to suit my needs, but hopefully, I’ve added enough comments to allow you to easily tweak it to fit your specific needs. 

Email ActiveWorkbook As Outlook Attachment

This VBA macro code with add the entire ActiveWorkbook as an attachment to a brand new Outlook message.

Sub EmailWorkbook()
'PURPOSE: Create email message with ActiveWorkbook attached
'SOURCE: www.TheSpreadsheetGuru.com

Dim SourceWB As Workbook
Dim DestinWB As Workbook
Dim OutlookApp As Object
Dim OutlookMessage As Object
Dim TempFileName As Variant
Dim ExternalLinks As Variant
Dim TempFilePath As String
Dim FileExtStr As String
Dim DefaultName As String
Dim UserAnswer As Long
Dim x As Long

Set SourceWB = ActiveWorkbook

'Check for macro code residing in
  If Val(Application.Version) >= 12 Then
    If SourceWB.FileFormat = 51 And SourceWB.HasVBProject = True Then
      UserAnswer = MsgBox("There was VBA code found in this xlsx file. " & _
        "If you proceed the VBA code will not be included in your email attachment. " & _
        "Do you wish to proceed?", vbYesNo, "VBA Code Found!")
     
    If UserAnswer = vbNo Then Exit Sub 'Handle if user cancels
  
    End If
  End If

'Determine Temporary File Path
  TempFilePath = Environ$("temp") & "\"

'Determine Default File Name for InputBox
  If SourceWB.Saved Then
    DefaultName = Left(SourceWB.Name, InStrRev(SourceWB.Name, ".") - 1)
  Else
    DefaultName = SourceWB.Name
  End If

'Ask user for a file name
  TempFileName = Application.InputBox("What would you like to name your attachment? (No Special Characters!)", _
    "File Name", Type:=2, Default:=DefaultName)
    
    If TempFileName = False Then Exit Sub 'Handle if user cancels
  
'Determine File Extension
  If SourceWB.Saved = True Then
    FileExtStr = "." & LCase(Right(SourceWB.Name, Len(SourceWB.Name) - InStrRev(SourceWB.Name, ".", , 1)))
  Else
    FileExtStr = ".xlsx"
  End If

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.DisplayAlerts = False

'Save Temporary Workbook
  SourceWB.SaveCopyAs TempFilePath & TempFileName & FileExtStr
  Set DestinWB = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

'Break External Links
  ExternalLinks = DestinWB.LinkSources(Type:=xlLinkTypeExcelLinks)

    'Loop Through each External Link in ActiveWorkbook and Break it
      On Error Resume Next
        For x = 1 To UBound(ExternalLinks)
          DestinWB.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
        Next x
      On Error GoTo 0
      
'Save Changes
  DestinWB.Save

'Create Instance of Outlook
  On Error Resume Next
    Set OutlookApp = GetObject(class:="Outlook.Application") 'Handles if Outlook is already open
  Err.Clear
    If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(class:="Outlook.Application") 'If not, open Outlook
    
    If Err.Number = 429 Then
      MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
      GoTo ExitSub
    End If
  On Error GoTo 0

'Create a new email message
  Set OutlookMessage = OutlookApp.CreateItem(0)

'Create Outlook email with attachment
  On Error Resume Next
    With OutlookMessage
     .To = ""
     .CC = ""
     .BCC = ""
     .Subject = TempFileName
     .Body = "Please see attached." & vbNewLine & vbNewLine & "Chris"
     .Attachments.Add DestinWB.FullName
     .Display
    End With
  On Error GoTo 0

'Close & Delete the temporary file
  DestinWB.Close SaveChanges:=False
  Kill TempFilePath & TempFileName & FileExtStr

'Clear Memory
  Set OutlookMessage = Nothing
  Set OutlookApp = Nothing
  
'Optimize Code
ExitSub:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.DisplayAlerts = True

End Sub

Email Selected Worksheets As Outlook Attachment

This VBA macro will attach only the selected tabs within the ActiveWorkbook to a new Outlook email message.

Sub EmailSelectedSheets()
'PURPOSE: Create email message with only Selected Worksheets attached
'SOURCE: www.TheSpreadsheetGuru.com

Dim SourceWB As Workbook
Dim DestinWB As Workbook
Dim OutlookApp As Object
Dim OutlookMessage As Object
Dim TempFileName As Variant
Dim ExternalLinks As Variant
Dim TempFilePath As String
Dim FileExtStr As String
Dim DefaultName As String
Dim UserAnswer As Long
Dim x As Long

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.DisplayAlerts = False

'Copy only selected sheets into new workbook
  Set SourceWB = ActiveWorkbook
  SourceWB.Windows(1).SelectedSheets.Copy
  Set DestinWB = ActiveWorkbook

'Check for macro code residing in
  If Val(Application.Version) >= 12 Then
    If SourceWB.FileFormat = 51 And SourceWB.HasVBProject = True Then
      UserAnswer = MsgBox("There was VBA code found in this xlsx file. " & _
        "If you proceed the VBA code will not be included in your email attachment. " & _
        "Do you wish to proceed?", vbYesNo, "VBA Code Found!")
    
    'Handle if user cancels
      If UserAnswer = vbNo Then
        DestinWB.Close SaveChanges:=False
        GoTo ExitSub
      End If
      
    End If
  End If

'Determine Temporary File Path
  TempFilePath = Environ$("temp") & "\"

'Determine Default File Name for InputBox
  If SourceWB.Saved Then
    DefaultName = Left(SourceWB.Name, InStrRev(SourceWB.Name, ".") - 1)
  Else
    DefaultName = SourceWB.Name
  End If

'Ask user for a file name
  TempFileName = Application.InputBox("What would you like to name your attachment? (No Special Characters!)", _
    "File Name", Type:=2, Default:=DefaultName)
    
    If TempFileName = False Then GoTo ExitSub 'Handle if user cancels
  
'Determine File Extension
  If SourceWB.Saved = True Then
    FileExtStr = "." & LCase(Right(SourceWB.Name, Len(SourceWB.Name) - InStrRev(SourceWB.Name, ".", , 1)))
  Else
    FileExtStr = ".xlsx"
  End If

'Break External Links
  ExternalLinks = DestinWB.LinkSources(Type:=xlLinkTypeExcelLinks)

    'Loop Through each External Link in ActiveWorkbook and Break it
      On Error Resume Next
        For x = 1 To UBound(ExternalLinks)
          DestinWB.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
        Next x
      On Error GoTo 0
      
'Save Temporary Workbook
  DestinWB.SaveCopyAs TempFilePath & TempFileName & FileExtStr

'Create Instance of Outlook
  On Error Resume Next
    Set OutlookApp = GetObject(class:="Outlook.Application") 'Handles if Outlook is already open
  Err.Clear
    If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(class:="Outlook.Application") 'If not, open Outlook
    
    If Err.Number = 429 Then
      MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
      GoTo ExitSub
    End If
  On Error GoTo 0

'Create a new email message
  Set OutlookMessage = OutlookApp.CreateItem(0)

'Create Outlook email with attachment
  On Error Resume Next
    With OutlookMessage
     .To = ""
     .CC = ""
     .BCC = ""
     .Subject = TempFileName
     .Body = "Please see attached." & vbNewLine & vbNewLine & "Chris"
     .Attachments.Add TempFilePath & TempFileName & FileExtStr
     .Display
    End With
  On Error GoTo 0

'Close & Delete the temporary file
  DestinWB.Close SaveChanges:=False
  Kill TempFilePath & TempFileName & FileExtStr

'Clear Memory
  Set OutlookMessage = Nothing
  Set OutlookApp = Nothing
  
'Optimize Code
ExitSub:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.DisplayAlerts = True

End Sub

Hidden Hacks For VBA Macro Coding

After 10+ years of creating macros and developing add-ins, I've compiled all the hacks I wish I had known years ago!

Learn These Hacks Now For Free!

Keep Learning

Explore more →

VBA Copy/Paste Multiple Excel Ranges To PowerPoint Slides

Stop Manually Copying and Pasting! This post is a continuation of the current most popular blog post on The Spreadsheet Guru...

Best Way To Paste Special Excel Objects As PowerPoint Images

Quality Matters I've written many times in the past on how the quality and formatting of your work can separate...

VBA To Add A Confidentiality Footer Statement In Excel, Word, or PowerPoint

What This VBA Code Does When handling sensitive data it is vital to display some sort of statement to let...

Chris Newman

Chris is a finance professional and Excel MVP recognized by Microsoft since 2016. With his expertise, he founded TheSpreadsheetGuru blog to help fellow Excel users, where he shares his vast creative solutions & expertise. In addition, he has developed over 7 widely-used Excel Add-ins that have been embraced by individuals and companies worldwide.