Martin,

You can use the following function, I hope it help you.

Anselmo.

Sub Mail_Selection_Outlook_Body()
'You must add a reference to the Microsoft outlook Library
'Is not working in Office 97
Dim source As Range
Dim dest As Workbook
Dim cell As Range

Dim myshape As Shape
Dim OutApp As Object
Dim OutMail As Object

Set source = Nothing
On Error Resume Next

' Select users (in a list) to send the message


lista = Empty
sw_mail = 0
For Each cell In Sheets("E-MAIL
ADDR").Columns("B").Cells.SpecialCells(xlCellTypeC onstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) =
"yes" Then
If sw_mail = 1 Then
lista = lista & ";" & cell.Value
Else
lista = cell.Value
sw_mail = 1
End If
End If
Next cell

If IsEmpty(lista) Then
MsgBox "There are no active users to send this information via
e-mail" & _
vbNewLine & " Add e-mail addresses to the list at E-MAIL ADDR
Sheet, and try again", vbOKOnly
Exit Sub
End If

' Start information selection

Sheet1.Activate

Range("b6:g25").Select
Set source = Selection
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is protect" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
If ActiveWindow.SelectedSheets.Count 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
ActiveSheet.Copy

Set dest = ActiveWorkbook

For Each myshape In dest.Sheets(1).Shapes
myshape.Delete
Next
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = lista
.CC = ""
.BCC = ""
.Subject = "Message with the requested information, Kind Regards€�
.HTMLBody = RangetoHTML

€˜ here you can use instead of :HTMLBody the next command sequence to
write in the
€˜ body of the message

€˜ .Body = "This is the information related of the sales or whatever
for" & now() & vbNewLine & ActiveSheet.range(€œE4€�).Value & vbNewLine & _
"Kind Regards"
'You can add other files also like this
€˜ .Attachments.Add (€œC:\MyDocuments\file.ppt")

.Send 'or use .Display
End With

source.Cells(1).Select
Dest.Close False
Set OutMail = Nothing
Set OutApp = Nothing
Set dest = Nothing
Sheet1.Activate

Application.ScreenUpdating = True
End Sub




"Martin" escribió:

Hello folks.
I need to link or embed the value of a single cell in excel into an html
email in an outlook public folder.
The value of the cell contents will change weekly and the email will need to
reflect this.
I'm not using word as an email editor. - is it possible ?
Thanks in advance

forgot to add - using office2000 sp3 fully patched