1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
| Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim lEndRow
Dim Value As String
Dim strbody As String
Set rng = Nothing
' Only send the visible cells in the selection.
Set rng = Sheets("Body").Range("A1:A1")
StartBody = Worksheets("Contacts").Cells(2, 5)
If rng Is Nothing Then
MsgBox "An unknown error has occurred. "
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = Worksheets("Contacts").Cells(2, 6)
.CC = ""
.BCC = ""
.Subject = Worksheets("Sujet").Cells(1, 1)
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & StartBody & RangetoHTML(rng) & "</body>"
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
Partager