This topic has not yet been rated - Rate this topic

OfficeTalk: Using the Excel Object Model to Send Workbooks and Ranges through E-Mail with Outlook (Part 2 of 2)

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
Published:   April 2010
Provided by:   MVP   Ron de Bruin, Microsoft Excel MVP | Frank Rice, Microsoft Corporation | About the Authors

Contents

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:

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.

Ff519602.note(en-us,office.12).gifNote:

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)

Ff519602.note(en-us,office.12).gifNote:

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
Ff519602.Important(en-us,office.12).gifImportant:

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

About the Authors

MVP   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.

Community Additions

Show:
© 2014 Microsoft. All rights reserved.