Sub Envoi_mails()
Dim oOutlook As Object
Dim oMail As Object
Dim PJ1 As String
Dim PJ2 As String
Dim PJ3 As String
Dim PJ4 As String
Dim PJ5 As String
Dim PJ6 As String
Dim Sh As Worksheet
Dim ShM As Worksheet
Dim oObjetWord As Object
Dim i As Integer
Dim DLG As Integer
Set Sh = ThisWorkbook.Sheets("publipostage_CFP")
Set ShM = ThisWorkbook.Sheets("mail_texte")
DLG = Sh.Range("a500").End(xlUp).Row
For i = 2 To DLG
If Sh.Range("L" & i).Value <> "NON" Then
Set oOutlook = CreateObject("Outlook.Application")
Set oMail = oOutlook.CreateItem(0)
PJ1 = Sh.Range("f" & i).Value
PJ2 = Sh.Range("g" & i).Value
PJ3 = Sh.Range("h" & i).Value
PJ4 = Sh.Range("i" & i).Value
PJ5 = Sh.Range("j" & i).Value
PJ6 = Sh.Range("k" & i).Value
ShM.Select
' intégrer le genre et le nom de la personne dans la cellule de bonjour
Range("A8").Select
ActiveCell.FormulaR1C1 = "Bonjour " & Sh.Range("S" & i).Value & " " & Sh.Range("aC" & i) & ","
' intégrer l'intitulé de la formation
Range("A10").Select
ActiveCell.FormulaR1C1 = "Vous trouverez, ci-joint, les documents concernant " & Sh.Range("aW" & i).Value
'ShM.Range("A8:a23").Select
With oMail
.Display
Set oObjetWord = .GetInspector.WordEditor
.To = Sh.Range("a" & i).Value
If Sh.Range("f" & i).Value = "" Then GoTo pointsuite1
.attachments.Add PJ1
pointsuite1:
If Sh.Range("g" & i).Value = "" Then GoTo pointsuite2
.attachments.Add PJ2
pointsuite2:
If Sh.Range("h" & i).Value = "" Then GoTo pointsuite3
.attachments.Add PJ3
pointsuite3:
If Sh.Range("i" & i).Value = "" Then GoTo pointsuite4
.attachments.Add PJ4
pointsuite4:
If Sh.Range("j" & i).Value = "" Then GoTo pointsuite5
.attachments.Add PJ5
pointsuite5:
If Sh.Range("j" & i).Value = "" Then GoTo pointsuite6
.attachments.Add PJ6
pointsuite6:
.Subject = Sh.Range("d" & i).Value
Set oObjetWord = .GetInspector.WordEditor
ShM.Range("A8:a23").Copy
oObjetWord.Range(0).Paste
'Send si on veut envoyer
Dim dtAujourdhui As String
dtAujourdhui = Format(Date, "dd mmmm yyyy")
Sh.Range("n" & i).Value = "Envoyé la " & dtAujourdhui
End With
End If
Set oMail = Nothing: Set oOutlook = Nothing
Next i
Sh.Select
MsgBox "Messages Envoyés"
End Sub