OfficeTalk: Using the Excel Object Model to Send Workbooks and Ranges through E-Mail with Outlook (Part 2 of 2)
This content is no longer actively maintained. It is provided as is, for anyone who may still be using these technologies, with no warranties or claims of accuracy with regard to the most recent product version or service release.
Summary: In this second part of the two-part series of article, Microsoft Excel MVP Ron de Bruin provides several samples and a useful add-in that makes it easy for your customers to send items from Microsoft Excel with Microsoft Outlook.
Applies to: Microsoft Excel 2000 | Microsoft Excel 2002 | Microsoft Office Excel 2003 | Microsoft Office Excel 2007 | Microsoft Excel 2010 | Microsoft Outlook 2000 | Microsoft Outlook 2002 | Microsoft Office Outlook 2003 | Microsoft Office Outlook 2007 | Microsoft Outlook 2010
Provided by: Ron de Bruin, Microsoft Excel MVP | Frank Rice, Microsoft Corporation | About the Authors
Contents
Sending E-Mail Messages from Excel with Outlook
Mailing Ranges or Selections as Attachments
Creating HTML for a Worksheet, Range, or Selection
Mailing a Single Worksheet in the Body of an E-Mail Message
Mailing a Range or Selection in the Body of an E-Mail Message
Mailing a Message to Each Person in a Range
Additional Tips for Changing the Code Samples
Conclusion
Additional Resources
Read Part One: OfficeTalk: Using the Excel Object Model to Send Workbooks and Ranges through E-Mail with Outlook (Part 1 of 2)
Sending E-Mail Messages from Excel with Outlook
This article features code samples that you can use to perform various e-mail functions from Microsoft Office Excel by using the Microsoft Office Outlook object model. Ron de Bruin, an Excel Most Valuable Professional (MVP) and a frequent contributor to the MSDN newsgroups, provides the samples and add-in. You can find more samples and an add-in (RDBMail Add-in) that adds several e-mail options to the ribbon user interface (UI) at Ron’s Web site.
Mailing Ranges or Selections as Attachments
The following subroutine sends a newly created workbook with the visible cells in the Range("A1:K50").The code uses the PasteSpecial method to paste values and cell formatting into the workbook that you send. The procedure saves the workbook with a date-time stamp before mailing. After sending the file, the workbook is deleted from the hard disk drive. Change the mail address and subject in the macro before you run the procedure.
Sub Mail_Range()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected. " & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
' You are using Excel 2000 or 2003.
FileExtStr = ".xls": FileFormatNum = -4143
Else
' You are using Excel 2007 or 2010.
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
' You can add other files by uncommenting the following statement.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
The following subroutine sends a newly created workbook with visible cells selected. This procedure also uses the PasteSpecial method. It also saves the workbook with a date-time stamp and deletes the file from the hard disk drive.
Sub Mail_Selection()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected. " & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If
If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You selected more than one sheet." & vbNewLine & _
"You selected only one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
' You are using Excel 2000, Excel 2002, Excel 2003, Excel 2007, or Excel 2010.
FileExtStr = ".xls": FileFormatNum = -4143
Else
' You are using Excel 2000, Excel 2002, Excel 2003, Excel 2007, or Excel 2010.
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
' You can add other files by uncommenting the following statement.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
.Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Creating HTML for a Worksheet, Range, or Selection
The function RangetoHTML is called in the following sections in this column:
Mailing a Single Worksheet in the Body of an E-Mail Message
Mailing a Range or Selection in the Body of an E-Mail Message
Ensure that you copy this function either into the same module as the macro or into another module in the same workbook.
Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Copy the range and create a workbook to receive the data.
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
' Publish the sheet to an .htm file.
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
' Read all data from the .htm file into the RangetoHTML subroutine.
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
' Close TempWB.
TempWB.Close savechanges:=False
' Delete the htm file.
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Mailing a Single Worksheet in the Body of an E-Mail Message
The following subroutine sends the active sheet in the body of an e-mail messages, without images. Change the mailing address before you run the macro.
Note
If you are using Microsoft Office 2002, Microsoft Office 2003, Microsoft Office 2007, or Microsoft Office 2010, you can find an example of mailing with images in the blog entry Mail selection, range or worksheet in the body of a mail with MailEnvelope.
Sub Mail_Sheet_Outlook_Body()
' You need to use this module with the RangetoHTML subroutine.
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
Set rng = ActiveSheet.UsedRange
' You can also use a sheet name here.
'Set rng = Sheets("YourSheet").UsedRange
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
If you want to add some text before the HTML body, you can add the following statements to the subroutine.
Dim StrBody As String
' Build the string that you want to add.
StrBody = "This is line 1" & "<br>" & _
"This is line 2" & "<br>" & _
"This is line 3" & "<br><br><br>"
' Or use this for cell values.
StrBody = Sheets("Sheet2").Range("A1").Value & "<br>" & _
Sheets("Sheet2").Range("A2").Value & "<br>" & _
Sheets("Sheet2").Range("A3").Value & "<br><br><br>"
Change the HTMLBody line to the following: .HTMLBody = StrBody & RangetoHTML(rng)
Note
The previous example, which adds text before the HTMLBody, does not work if Microsoft Word is your e-mail editor in Outlook 2000, Outlook 2002, and Outlook 2003. To change this, start Outlook, and on the Tools menu, select Options, and then click Mail Format.
Mailing a Range or Selection in the Body of an E-Mail Message
The following subroutine sends the visible cells in the selection, in the body of an e-mail message without images.
Sub Mail_Selection_Range_Outlook_Body()
' You need to use this module with the RangetoHTML subroutine.
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
' Only send the visible cells in the selection.
Set rng = Selection.SpecialCells(xlCellTypeVisible)
' You can also use a range with the following statement.
' Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
' In place of the following statement, you can use ".Display" to
' display the e-mail message.
.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Mailing a Message to Each Person in a Range
To use the code that is presented in this section, first create a table on the active sheet with the following columns:
Column A: Names of the people
Column B: E-mail addresses
Column C: yes or no ( if the value is yes, an e-mail message is created)
The following subroutine loops through each row on the active sheet and, if there is an e-mail address in column B and Yes in column C, an e-mail message for each person listed in column A is created that has a reminder such as the following example.
Dear Jelle (Jelle is a name in column A, for example.)
Please contact us to discuss bringing your account up to date.
Sub Create_Mail_From_List()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
'You can also add files like this:
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display.
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
You can also use the values of cells in a range as the body text. The next example adds all the text/values that are in the range G1:G20 to the body.
Add this code to the subroutine before the loop starts.
Dim strbody As String
For Each cell In Range("G1:G20")
strbody = strbody & cell.Value & vbNewLine
Next
And replace the body line with this one.
.Body = "Dear " & Cells(cell.Row, "A").Value & vbNewLine & vbNewLine & strbody
If you want to create e-mail messages that are formatted, if you are using Office 2000, Office 2002, Office 2003, Office 2007, or Office 2010, you can use the HTMLBody object instead of the Body object.
.HTMLBody = "<H3><B>Dear " & cell.Offset(0, -1).Value & "</B></H3>" & _
"Please contact us to discuss bringing your account up to date.<BR><BR>" & _
"<B>Regards Ron de Bruin</B>"
Additional Tips for Changing the Code Samples
In addition to the previous code examples, this section presents other options that you can use to make your code more versatile. You should periodically check the tips page of Ron’s Web site for updates and additional tips.
Changes that you can make to the To, CC, and BCC lines
Use the following to send to more than one person.
.To = "ron@debruin.nl;jelle@debruin.nl"
You can use an e-mail address in a cell. You can do the same for the CC, BCC, or subject lines.
.To = ThisWorkbook.Sheets("Sheet1").Range("C1").Value
You can send to an Outlook distribution group, as follows.
Instead of .To ron@debruin.nl, use .To = "GroupName".
You can also use this to add a group name or contact instead of To.
.Recipients.Add "GroupName"
To send to all e-mail addresses in a range and then check whether the e-mail address is correct, add the following code to the macro and change the To line to this: .To = strto
Dim cell As Range
Dim strto As String
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A1:A10")
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
If you want to use only e-mail addresses that have the word "yes" in the column next to them, you can replace If cell.Value Like "?*@?*.?*" Then with If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then.
Changes that you can make to the Save line
You can change the TempFileName string in the code to change the file name and to use a cell reference.
TempFileName = "YourFileName"
TempFileName = "YourFileName " & Format(Now, "dd-mmm-yy h-mm-ss")
TempFileName = ThisWorkbook.Sheets("Sheet1").Range("C1").Value
Important
Use error checking to verify that a file that has that name does not already exist or is not already open. In the examples in this column, the file name includes the date and time so that the possibility that the file name already exists is very small.
Change sender name and reply address
If you want to change the sender name and reply address, add this code line.
' The receiver can see the original mail address in the properties.
.SentOnBehalfOfName = """SenderName"" <Reply@Address.com>"
Set the importance of an e-mail message
' 0 = Low, 2 = High, 1 = Normal
.Importance = 2
Add a read receipt request
.ReadReceiptRequested = True
Specify a deferred delivery time
' Stay in the Outbox until this date and time.
.DeferredDeliveryTime = "1/6/2007 10:40:00 AM"
' Wait four hours
.DeferredDeliveryTime = DateAdd("h", 4, Now)
Add a signature to the e-mail message
For information about adding a signature to the e-mail message, see the blog entry Insert Outlook Signature in Mail.
Conclusion
In this series of articles, we looked at several code samples that you can use to make sending e-mail messages from Excel with Outlook much easier. The RDBMail add-in for Excel and Outlook can assist you in sending customized Excel workbooks and worksheets in e-mail messages. Exploring and implementing these tools and techniques into your own applications can help make your job as a developer easier and make your solutions more versatile.
Additional Resources
See the following for more information about these topics.
About the Authors
Ron de Bruin is an Excel Most Valuable Professional (MVP) and a frequent contributor to the newsgroups. For more information, see Ron's Excel page.
Frank Rice is a senior programming writer and frequent contributor to the Microsoft Office Developer Center.