Good afternoon all,
I've seen a few posts recently asking about sending either sending a range or a worksheet in an Outlook email as the body of the message through code. I've been looking at this and think I've come up with something that might work. I'd appreciate it if any of you XL kings and queens would take a look and see if the code works OK on your machine. I've sent a few messages to myself (sad I know
) and they seem to work well.
Here's the code. You need to set a reference to the Outlook object Library AND the Microsoft Scripting Runtime in order for this code to work.
Any ideas for improvement, suggestions, comments gratefully received.
Dan
This message was edited by dk on 2002-05-14 07:21
I've seen a few posts recently asking about sending either sending a range or a worksheet in an Outlook email as the body of the message through code. I've been looking at this and think I've come up with something that might work. I'd appreciate it if any of you XL kings and queens would take a look and see if the code works OK on your machine. I've sent a few messages to myself (sad I know
![Smile :smile: :smile:](https://cdn.jsdelivr.net/joypixels/assets/8.0/png/unicode/64/1f642.png)
Here's the code. You need to set a reference to the Outlook object Library AND the Microsoft Scripting Runtime in order for this code to work.
Any ideas for improvement, suggestions, comments gratefully received.
Dan
Code:
Option Explicit
Sub SendRange()
'Sends a specified range in an Outlook message and retains Excel formatting
'Code written by Daniel Klann 2002
'References needed :
'Microsoft Outlook Object Library
'Microsoft Scripting Runtime
'Dimension variables
Dim olApp As Outlook.Application, olMail As Outlook.MailItem
Dim FSObj As Scripting.FileSystemObject, TStream As Scripting.TextStream
Dim rngeSend As Range, strHTMLBody As String
'Select the range to be sent
On Error Resume Next
Set rngeSend = Application.InputBox("Please select range you wish to send.", , , , , , , 8 )
If rngeSend Is Nothing Then Exit Sub 'User pressed Cancel
On Error GoTo 0
'Now create the HTML file
ActiveWorkbook.PublishObjects.Add(xlSourceRange, "C:tempsht.htm", rngeSend.Parent.Name, rngeSend.Address, xlHtmlStatic).Publish True
'Create an instance of Outlook (or use existing instance if it already exists
Set olApp = CreateObject("Outlook.Application")
'Create a mail item
Set olMail = olApp.CreateItem(olMailItem)
'Open the HTML file using the FilesystemObject into a TextStream object
Set FSObj = New Scripting.FileSystemObject
Set TStream = FSObj.OpenTextFile("C:tempsht.htm", ForReading)
'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = TStream.ReadAll
olMail.HTMLBody = strHTMLBody
olMail.Display
End Sub