VBA - envoyer un mail outlook via macro excel

Sub SendResults()
'
' SendResults Macro
' Send Results to AWH manager
'

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Daily Results").Range("A2:J82").SpecialCells(xlCellTypeVisible)

On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = "test@outlook.com"
.CC = ""
.BCC = ""
.Subject = B1
.HTMLBody = Range("A2:J82")
.Send
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing



End Sub

Cliquez pour agrandir...