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
'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.
UPDATE: JP at JP Software Technologies posted a follow-up to this.