Attach Current Workbook to Current Email

I email workbooks all the time. Sometimes I send them unprompted in brand-new emails, in which case Excel’s “Send as Attachment” command works great. More often though, I attach them to a reply, in which case it doesn’t.

In addition, there are other traits of “Send as Attachment” which can be irksome.

  • It locks the workbook until you close the email. Invariably I see something I want to change and then stab pointlessly at the workbook until I notice Outlook blinking.
  • It doesn’t prompt you to save the workbook if you’ve made changes.
  • it doesn’t let you know if Outlook’s not open.

To remedy these issues I had to (yay!) write some code. Here it is:

Sub Attach_Current_Wb_To_Current_Email()

'This requires a reference to Microsoft Outlook #.# Object Library

Dim outApp As Outlook.Application
Dim OutMail As Outlook.MailItem

If ActiveWorkbook Is Nothing Then
  MsgBox ("No active workbook.")
  GoTo Exit_Point
End If
If ActiveWorkbook.Path = vbNullString Then
  MsgBox ("This workbook has never been saved.")
  GoTo Exit_Point
End If
If ActiveWorkbook.Saved = False Then
  If MsgBox(prompt:="Changes have been made since last save." & vbCrLf & _
      "Continue?", Buttons:=vbOKCancel + vbQuestion) = vbCancel Then
    GoTo Exit_Point
  End If
End If
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
  If MsgBox(prompt:="Outlook isn't open." & vbCrLf & "Open and create a new email?", _
      Buttons:=vbOKCancel + vbQuestion) = vbOK Then
    Set outApp = CreateObject("Outlook.Application")
    Set OutMail = outApp.CreateItem(olMailItem)
    OutMail.Parent.Display
    OutMail.Display
  Else
    GoTo Exit_Point
  End If
End If
With outApp
  If .ActiveInspector Is Nothing Then
    MsgBox "There is no open item"
    GoTo Exit_Point
  End If
  If Not TypeOf .ActiveInspector.CurrentItem Is MailItem Then
    MsgBox "Type of current item isn't email"
    GoTo Exit_Point
  End If
  Set OutMail = .ActiveInspector.CurrentItem
  If OutMail.Sent Then
    MsgBox "Current email was already sent."
    GoTo Exit_Point
  End If
  OutMail.Attachments.Add ActiveWorkbook.FullName
  .ActiveInspector.Display
End With

Exit_Point:
Set outApp = Nothing
End Sub

One thing it doesn’t do that Excel’s built-in command does is send a never-saved workbook, e.g., “Book1.” In addition:

  • If you haven’t saved all your changes it prompts you to continue or cancel.
  • If Outlook isn’t open it prompts you to open it and create a new email, or cancel.
  • If there is no open item then it exits.  Ditto if the open item isn’t an email or if the email isn’t a draft.

When Outlook is opened from the code I get the little icon and message below, same as when I use Activesync.  Outlook seems to work the same as ever though.
Outlook warning

UPDATE: JP at JP Software Technologies posted a follow-up to this.