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(xlCellTypeConstants)
If cell.Value Like "?*[ at ]?*.?*" 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ó:
[Quoted Text] > 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
>
>
>
|