Sub Mail()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim TempFilePath As String, Strbody As String, TempFileName As String
Dim FileExtStr As String, FichierSignature As String, Signature As String
Dim FileFormatNum As Long, DL As Long, DLt As Long, j As Long
Dim Sourcewb As Workbook, destwb As Workbook
Dim OutApp As Object, OutMail As Object
Dim sFichier1 As String, sFichier2 As String, sFichier3 As String
sFichier1 = Worksheets("Mail").Range("C4")
sFichier2 = Worksheets("Mail").Range("C5")
sFichier3 = Worksheets("Mail").Range("C6")
If Worksheets("Liste").Range("D3") = "" Then
Prbemail
Exit Sub
End If
Application.DisplayAlerts = False
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'---
Strbody = "Bonjour " & Prenom & ",<br>" _
& "<br>" _
& "Cordialement,<br>" _
& "<br>" _
& "<br>"
'--------------------------------------------------------------------------------------------------
FichierSignature = getSignature()
'--------------------------------------------------------------------------------------------------
If Dir(FichierSignature) <> "" Then Signature = GetBoiler(FichierSignature)
'---
DL = Worksheets("Liste").Cells(Rows.Count, 4).End(xlUp).Row
DLt = Worksheets("Mail").Cells(Rows.Count, 3).End(xlUp).Row
'
'---- Construction du corps de mail dans lequel 'Texte0' sera inséré plus tard
'
Strbody = "<font style='font-family: Arial ;font-size: 10pt ;font-style: Regular; '>[Texte0]<br>"
For j = 10 To DLt
Strbody = Strbody & Worksheets("Mail").Range("C" & j) & "<br>"
Next
Strbody = Strbody & "<br>" & Signature
'
'--- Initialisation de l'objet Outlook Application
'
Set OutApp = CreateObject("Outlook.Application")
'
'--- Construction des mails et envois
'
For i = 3 To DL
'
' Insertion des parties variable du corps de mail
'
If Worksheets("Liste").Range("B" & i) <> "" Then
Texte0 = "Bonjour " & Worksheets("Liste").Range("A" & i) & " " & Worksheets("Liste").Range("B" & i) & "," & "<br>"
Else
Texte0 = "Bonjour " & Worksheets("Liste").Range("C" & i) & ","
End If
Strbody = Replace(Strbody, "[Texte0]", Texte0)
'
' Création d'un nouveau mail item
'
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Worksheets("Liste").Range("D" & i)
.Cc = ""
.BCC = ""
.Subject = Worksheets("Mail").Range("C2")
.HTMLBody = Strbody
If sFichier1 <> "" Then .Attachments.Add sFichier1
If sFichier2 <> "" Then .Attachments.Add sFichier2
If sFichier3 <> "" Then .Attachments.Add sFichier3
.display
End With
'
' nettoyage de la variable objet mail courant
Set OutMail = Nothing
'.Close savechanges:=False
Next
'
'--- Nettoyage des variable objet outlook
'
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.DisplayAlerts = True
End Sub