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

 

[Andy W]

Re: Sending a selected range through Outlook - NOT A QUESTIO

this is the code I am using, is there anything wrong with it as it is still copying the range to the centre

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

On Error Resume Next
Set rngeSend = Application.Range("order")
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 & "\order.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

'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)

With oOutlookMessage

'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = "Please can you order the following:
" & oFSTextStream.ReadAll & "
Thankyou
" & "
" & Range("d3")

.Subject = "Stock order"
.To = "andrew.wills@skipton.co.uk"
oOutlookMessage.HTMLBody = strHTMLBody
oOutlookMessage.Display

.Send

End With

 

[Ivan F Moala]

I had a look and got a Diff result then I got before
There must be a setting that has change ??

I can give you a hack to change the Actual text stream BUT
as I said, there must be an easier way ???

The actual generated code

<DIV id="Sys" align=center x:publishsource="Excel">

needs to be changed.

change to

'Now set the HTMLBody property of the message to the text contained in the TextStream object
strHTMLBody = TStream.ReadAll
strHTMLBody = ReplaceSubstring(strHTMLBody, "align=center x:publishsource=", "align=left x:publishsource=")

'//  Replace a substring within another string.
Public Function ReplaceSubstring(ByVal Txt As String, ByVal From_str As String, ByVal To_str As String) As String
Dim Pos As Double
Dim New_text As String
Dim From_len As Integer

    From_len = Len(From_str)
    Do While Len(Txt) > 0
        Pos = InStr(Txt, From_str)
        If Pos = 0 Then
            New_text = New_text & Txt
            Txt = ""
        Else
            New_text = New_text & _
                Left(Txt, Pos - 1) & To_str
            Txt = Mid(Txt, Pos + From_len)
        End If
    Loop
    ReplaceSubstring = New_text
End Function

 

[Andy W]

Re: Sending a selected range through Outlook - NOT A QUESTIO

Thanks for that, just what the doctor ordered.

 

[halow]

Re: Sending a selected range through Outlook - NOT A QUESTIO

I have tried using the code from http://www.danielklann.com/Excel/sending_a_range_as_the_body.htm and it worked very well except that this would overwrite the signature in the email. Is there any way to prevent this?

Can i insert any messages to the email body automatically when i run this macro?

 

[Ivan F Moala]

Re: Sending a selected range through Outlook - NOT A QUESTIO

You will have to insert your signature in manually ie Insert > Signature

 

[halow]

Re: Sending a selected range through Outlook - NOT A QUESTIO

ok, i will do that

thanks alot!!

 

[jeffcravener]

Re: Sending a selected range through Outlook - Problem!

I keep getting a 'file can't be found error' on this line:

Set TStream = FSObj.OpenTextFile("C:tempsht.htm", ForReading)

I have watched that file get created on the c: drive...I have even waited a bit after it is created before having it read, but I still get the error...any ideas?

 

[NateO]

Re: Sending a selected range through Outlook - NOT A QUESTIO

You're missing a backslash eh:

Set TStream = FSObj.OpenTextFile("C:\tempsht.htm", ForReading)

An issue with the old board.

 

[en4red]

Regarding Rich Text vs HTML Text

Is there anyway to paste the excel range as Rich Text in the body of the email as opposed to HTML text? Everything else works fine, but I just can't figure out how to get it in RICH text. Any help would be very much appreciated. Thank you.

 

[Ivan F Moala]

you could try (untested)

aEmail.BodyFormat = 3 ' = olFormatRichText

where aEmail is your email object