Sub Message1()
Dim I As Integer, MailTo As String, MailCC As String
Dim vPJ, vPJ1, vPJ2, vPJ3, vPJ4, vPJ5, vPJ6, vPJ7, vPJ8, vPJ9, vLigne
Dim OLApplication As Outlook.Application, OLMail As Outlook.MailItem
Set OLApplication = CreateObject("Outlook.Application")
Set OLMail = OLApplication.CreateItem(OLMailItem)
For I = 15 To 200 ' A changer si le début pas la ligne 15
If Cells(I, 10) = "X" Then ' colonne J = 10
MailTo = MailTo & Cells(I, 9) & ";" ' 3 pour regarder _
ta colonne I=9 si c'est là où est l'adresse, à modifier pour ton cas
End If
If Cells(I, 10) = "C" Then
MailCC = MailCC & Cells(I, 9) & ";"
End If
If Cells(I, 10) = "I" Then
MailBCC = MailBCC & Cells(I, 9) & ";"
End If
Next I
ObjetMessage = Cells(2, 4) ' A changer car ici il y aura l'objet du message
'Récup. message, avec sauts de ligne
For Each vLigne In [F2:F13] ' A changer endroit ou tu écris le messgae via excel
CorpsMessage = CorpsMessage & vLigne & vbLf
Next ' La suite également
vPJ = Range("I3")
vPJ1 = Range("I4")
vPJ2 = Range("I5")
vPJ3 = Range("I6")
vPJ4 = Range("I7")
vPJ5 = Range("I8")
vPJ6 = Range("I9")
vPJ7 = Range("I10")
vPJ8 = Range("I11")
vPJ9 = Range("I12")
With OLMail
.To = MailTo ' Destinataire
.CC = MailCC ' Copie
.BCC = MailBCC ' Invisible
.Importance = olImportanceNormal
.Subject = ObjetMessage ' Sujet
.Body = CorpsMessage ' Message
''''''''''' .Attachments = vPJ 'Pièce jointe
On Error Resume Next
For J = 3 To 12 ' Ici encore à changer
If Range("I" & J).Value <> "" Then
.Attachments.Add Range("I" & J).Value 'j'ai juste ajoute cela
End If
Next J
.Categories = "Daily"
.OriginatorDeliveryReportRequested = True ' Accusé de dépôt
.ReadReceiptRequested = True ' Accusé de lecture
' .Send '<<<<<<<<<<<<<<<Pour envoyer directement
.Display '<<<<<<<<<<<<<Pour voir le mail avant envoi
End With
End Sub