Sending a selected range through Outlook - NOT A QUESTION!

dk

MrExcel MVP
Joined
Feb 15, 2002
Messages
2,942
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

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
This message was edited by dk on 2002-05-14 07:21
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
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.....
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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

<font face=Courier New><SPAN style="color:darkblue">Option</SPAN> <SPAN style="color:darkblue">Explicit</SPAN>

<SPAN style="color:darkblue">Dim</SPAN> ID <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>

<SPAN style="color:darkblue">Const</SPAN> sGuid <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN> = " Referencing ["
<SPAN style="color:darkblue">Const</SPAN> sMsg <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">String</SPAN> = "You may have to manually set a reference to the ["

<SPAN style="color:darkblue">Sub</SPAN> CreateRef_Library_ScFso()
<SPAN style="color:green">'// Set a Reference to SCRRUN.DLL = Scripting.FileSystemObject</SPAN>
<SPAN style="color:green">'// Microsoft scripting Runtime</SPAN>
<SPAN style="color:green"><SPAN style="color:green"><SPAN style="color:green">'// If it already exits Resume & Handle latter!</SPAN></SPAN></SPAN>

<SPAN style="color:darkblue">On</SPAN> <SPAN style="color:darkblue">Error</SPAN> <SPAN style="color:darkblue">Resume</SPAN> <SPAN style="color:darkblue">Next</SPAN>

<SPAN style="color:darkblue">Set</SPAN> ID = ThisWorkbook.VBProject.References

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

<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN>

<SPAN style="color:darkblue">Sub</SPAN> CreateRef_Library_Outlook()
<SPAN style="color:green">'// Set a Reference to Microsoft Outlook M.m Object Library = msoutlM.olb</SPAN>
<SPAN style="color:green">'// Microsoft Outlook M.n Object Library</SPAN>
<SPAN style="color:green"><SPAN style="color:green"><SPAN style="color:green">'// If it already exits Resume & Handle latter!</SPAN></SPAN></SPAN>
<SPAN style="color:darkblue">On</SPAN> <SPAN style="color:darkblue">Error</SPAN> <SPAN style="color:darkblue">Resume</SPAN> <SPAN style="color:darkblue">Next</SPAN>

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

<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN>

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

<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN>
</FONT>
 
Upvote 0
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
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,214,551
Messages
6,120,161
Members
448,948
Latest member
spamiki

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top