Sub Envoi_Mail()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim PJ As String
Dim List_To As String, List_Cop As String, rng As Range, t, tt
With Worksheets("Mail")
Set rng = .Range(.Cells(2, "N"), .Cells(Rows.Count, "N").End(3))
If rng.Rows.Count > 2 Then
t = Application.Transpose(rng.Value): List_To = Join(t, ";")
tt = Application.Transpose(rng.Offset(, 1)): List_Cop = Join(tt, ";")
Else
MsgBox "Attention : Vous n'avez pas de destinataire !"
Exit Sub
End If
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Worksheets("Mail")
PJ = .Range("M2")
Sujet = .Range("J3")
strbody = .Shapes("CorpsMessage").TextFrame.Characters.Text & vbTab
End With
With OutMail
.To = List_To
.CC = List_Cop
.BCC = ""
.Subject = Sujet
.Body = strbody
If UCase(PJ) = "OUI" Then
Dim fichier As Variant
fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
.Attachments.Add (fichier)
End If
.Display
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub