Sending a selected range through Outlook - NOT A QUESTION!

[dk]

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

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

This message was edited by dk on 2002-05-14 07:21

 

[jimrward]

All the above code works fine, but I have found that it includes hidden columns, if i have data in columns A-I with Col H hidden, with no sheet protection turned on, and run the macro and select A1 to I40, column H is included in the final HTML pasting to OUTLOOK

Is there a way to get around this as protecting the sheet does not exclude COL H either.

 

[en4red]

Thank you for the respone Ivan, I really do appreciate it. Not sure on how I would be able to work it into this code that I have been using since it saves an HTML file to my temp drive and implements it into the email body. Unfortunately, it does exactly what I need except for not having RICH text capability.

Sub SendRange()

'Sends a specified range in an Outlook message and retains Excel formatting

'Dimension variables
Dim oOutlookApp As Object, oOutlookMessage As Object
Dim oFSObj As Object, oFSTextStream As Object
Dim rngeSend As Range, strHTMLBody As String, strTempFilePath As String

'Select the range to be sent
'On Error Resume Next
'Set rngeSend = Application.InputBox(Prompt:="Please select range you wish to send.", _
'Type:=8, Default:=Selection.Address)
Range("L1").Select
Set rngeSend = Selection.CurrentRegion

'If rngeSend Is Nothing Then Exit Sub 'User pressed Cancel
'On Error GoTo 0

'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\XLRange.htm"


'Now create the HTML file - NOTE! xlSourceRange and xlHtmlStatic have been replaced by their
'numeric values due to a potential error (unexplained) noted by Ivan F Moala 15/5/03
ActiveWorkbook.PublishObjects.Add(4, strTempFilePath, _
rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True

'Create an instance of Outlook (or use existing instance if it already exists
Set oOutlookApp = CreateObject("Outlook.Application")

'Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(0)

'Open the HTML file using the FilesystemObject into a TextStream object
Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, 1)

'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = oFSTextStream.ReadAll

'By default the range will be centred. This line left aligns it and you can
'comment it out if you want the range centred.
strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", , , vbTextCompare)

oOutlookMessage.HTMLBody = strHTMLBody

oOutlookMessage.Display

End Sub
-------------------

Do you have any code utilizing abody email correctly? Most of the stuff I have found on the internet (including this board and OZGrid) doesn't work or does not paset the format correctly into the email body. Any help would be most appreciated.

 

[dk]

All the above code works fine, but I have found that it includes hidden columns, if i have data in columns A-I with Col H hidden, with no sheet protection turned on, and run the macro and select A1 to I40, column H is included in the final HTML pasting to OUTLOOK

Is there a way to get around this as protecting the sheet does not exclude COL H either.

Hello,

You could try this slightly modified code. It copies the visible cells to a temporary sheet and uses that as the range to send. Let me know if it works for you.

Dan

Sub SendRange()

'Sends a specified range in an Outlook message and retains Excel formatting

'Modified by Daniel Klann March 2005 for "jimrward" on MrExcel forum


'**************************
'http://www.danielklann.com
'**************************

'Dimension variables
Dim oOutlookApp As Object, oOutlookMessage As Object
Dim oFSObj As Object, oFSTextStream As Object
Dim rngeSend As Range, strHTMLBody As String, strTempFilePath As String
Dim shtTemp As Worksheet

'Select the range to be sent
On Error Resume Next
Set rngeSend = Application.InputBox(Prompt:="Please select range you wish to send.", _
Type:=8, Default:=Selection.Address)

If rngeSend Is Nothing Then Exit Sub 'User pressed Cancel
On Error GoTo 0

Set shtTemp = Worksheets.Add
rngeSend.SpecialCells(xlCellTypeVisible).Copy

shtTemp.Range("A1").PasteSpecial xlPasteAll

Set rngeSend = shtTemp.UsedRange


'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\XLRange.htm"


'Now create the HTML file - NOTE! xlSourceRange and xlHtmlStatic have been replaced by their
'numeric values due to a potential error (unexplained) noted by Ivan F Moala 15/5/03
ActiveWorkbook.PublishObjects.Add(4, strTempFilePath, _
rngeSend.Parent.Name, rngeSend.Address, 0, "", "").Publish True

'Delete the temporary sheet
Application.DisplayAlerts = False: shtTemp.Delete: Application.DisplayAlerts = True


'Create an instance of Outlook (or use existing instance if it already exists
Set oOutlookApp = CreateObject("Outlook.Application")

'Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(0)

'Open the HTML file using the FilesystemObject into a TextStream object
Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, 1)

'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = oFSTextStream.ReadAll

'By default the range will be centred. This line left aligns it and you can
'comment it out if you want the range centred.
strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", , , vbTextCompare)

oOutlookMessage.HTMLBody = strHTMLBody

oOutlookMessage.Display


End Sub

 

[en4red]

What's up Dan? Thank you for the reply... the code works fine except the email body is in HTML format. For formatting purposes I need the email body to be in RICH format and still have the cells align correctly. I just have a table with two columns and a variable amount of rows.

Any ideas? Thanks again!

Lorenzo

 

[jimrward]

Daniel

Nearly there the hidden cells stay hidden the only thing is the columns default to a fixed width and therefore chew up dates and longer text values.

Thinking aloud one must be able to create an array of column widths and loop thru and apply this to the temp sheet before converting to HTML, thus mirroring the original exactly.

 

[sgt_spike]

Recipients

How and where would I put a recipient automaticly?

 

[dk]

Re: Recipients

How and where would I put a recipient automaticly?

Modify the code to this:

'Create a mail item 
Set oOutlookMessage = oOutlookApp.CreateItem(0) 
oOutlookMessage.To = "someone@somewhere.com"
'
'rest of code

Let me know if you can't get it to work.

Ih ih ihhhh

Dan

 

[sgt_spike]

Re: Recipients

How and where would I put a recipient automaticly?

Modify the code to this:

'Create a mail item 
Set oOutlookMessage = oOutlookApp.CreateItem(0) 
oOutlookMessage.To = "someone@somewhere.com"
'
'rest of code

Let me know if you can't get it to work.

Ih ih ihhhh

Dan

Thats works perfect. The only problem I have is there are date cells where I would put in a date, and when use the code to attach the spreadsheet to an email the dates turn into this (******). Why is that?

 

[wgk]

But to automatically set it up then ...

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
Great coding, I found it just at the right time, because I need to dynamically reference to the MSPPT object library.<o></o>
<o></o>
I have one problem, which I couldn't solve with your dyn. ref. coding.<o></o>
<o></o>
If the user saves a Excel 2003 workbook with Excel 2007, the MSPPT from O7 remains. This causes problems when opening in Excel 2003, the dyn ref runs properly, but with no assignment of the O3 MSPPT library. Instead the MSPPT from O7 exists with the prefix "Not existing".<o></o>
<o></o>
Is there a way to programmatically remove a library from the reference?<o></o>

 

[wgk]

<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
<o></o>
<o></o>
Is there a way to programmatically remove a library from the reference?<o></o>

Should have thought about it earlier looking at the VBA Language Reference

Sorry

This is how I made it work:


Sub Workbook_BeforeClose(Cancel As Boolean)

Dim objRef As Object

Set objRef = ThisWorkbook.VBProject.References.Item(7)

ThisWorkbook.VBProject.References.Remove objRef

Set objRef = Nothing

End Sub