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 ]

[Ivan F Moala]

DK

Excellent......Have copied this code.

The only thing I can add is to automatically
referece the code Libraries.
This is something I'll setup for other users
JUST IN CASE.....

[crimlet]

Sorry, but when using win 98 xl 97 how do I reference OL express ect...

[dk]

Sorry Crimlet, but this code will only work with Outlook, not OE. Unfortunately it's not even possible to convert the code to work properly with OE as it doesn't support automation (which is what this code basically is doing).

Regards,
Dan

[crimlet]

Sorry, I did mean outlook as apposed to OL express

[Tom Schreiner]

Bother Ivan later about the code to reference the library in the procedure it'self....
For now, open your VBE and click on Tools, References, then find Microsoft Outlook 8.0 Object Library, check it and click Ok.
This will set a reference to the Library you need.
Tom

[Ivan F Moala]

On 2002-05-15 01:39, TsTom wrote:
Bother Ivan later about the code to reference the library in the procedure it'self....
For now, open your VBE and click on Tools, References, then find Microsoft Outlook 8.0 Object Library, check it and click Ok.
This will set a reference to the Library you need.
Tom

You also need to reference the SCRRUN.DLL
But to automatically set it up then;

EDIT: using Juan's Addin

Option Explicit

Dim ID As Object

Const sGuid As String = " Referencing ["
Const sMsg As String = "You may have to manually set a reference to the ["

Sub CreateRef_Library_ScFso()
'// Set a Reference to SCRRUN.DLL = Scripting.FileSystemObject
'// Microsoft scripting Runtime
'// If it already exits Resume & Handle latter!

On Error Resume Next

Set ID = ThisWorkbook.VBProject.References

ID.AddFromGuid "{420B2830-E718-11CF-893D-00A0C9054228}", 1, 0
**
If Err.Number <> 32813 And Err.Number <> 0 Then
****ErrMsg Err.Number, Err.Description, Err.HelpFile, Err.HelpContext, _
********"Microsoft scripting Runtime"
End If

End Sub

Sub CreateRef_Library_Outlook()
'// Set a Reference to Microsoft Outlook M.m Object Library = msoutlM.olb
'// Microsoft Outlook M.n Object Library
'// If it already exits Resume & Handle latter!
On Error Resume Next

Set ID = ThisWorkbook.VBProject.References
ID.AddFromGuid "{00062FFF-0000-0000-C000-000000000046}", 7, 0
If Err.Number <> 32813 And Err.Number <> 0 Then
****ErrMsg Err.Number, Err.Description, Err.HelpFile, Err.HelpContext, _
********"Microsoft Outlook Object Library"
End If

End Sub

Sub ErrMsg(En, Ed, Eh, Ehc, ss)
'// Error Object handler
MsgBox "Error Number:= " & Err.Number & vbCr _
********& "Error Discrp:= " & Err.Description & vbCr & vbCr & sMsg & ss & "]", _
********vbMsgBoxHelpButton, _
********"Error" & sGuid & ss & "]", Err.HelpFile, Err.HelpContext
Set ID = Nothing

End Sub

[dk]

Ivan,

I like this code very much. I was aware that you can add references 'on-the-fly' but have never tried it. I've got a few of questions:-

1. Where do you find the GUID number? Is it in the registry?

2. Does the GUID take account of different versions of software? e.g. will this code install a reference to Outlook regardless of its version?

3. How comes the AddFromGUID method doesn't appear when you type it into the object browswer? If I set a reference to the VBA extensibility library I can find it - do you know what's going on here?

Thanks,
Dan

[eddy]

Yipeeeeeeeeeeeeeeeeeee!!!
Thanks to everyone for this code. I have been looking to do just this for ages. It seems to work fine with any combination of - WIN98/2000/XP & Office 2000/2002.
Thanks also to TSTom for letting me know the thread was here.
One happy bunny!

[Juan Pablo González]

Hey dk, great code ! I would only add one thing to it. Kill the sht.html file after... Just a little detail !