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
| Sub Mail_workbook_Outlook_1()
'Working in 2000-2007
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ActiveSheet.Range("C9").Value & ";" & _
ActiveSheet.Range("C10").Value & ";" & _
ActiveSheet.Range("C11").Value & ";" & _
ActiveSheet.Range("C12").Value & ";" & _
ActiveSheet.Range("C13").Value & ";" & _
ActiveSheet.Range("C14").Value & ";" & _
ActiveSheet.Range("C15").Value & ";"
.CC = ""
.BCC = ""
.Subject = "Suivi des dossiers Groupe"
.HTMLBody = "Bonjour, merci de bien vouloir prendre en compte les informations ci-dessous. Ceci est une relance automatique, veuillez nous excuser si cela croise votre réponse."
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
Partager