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
| Sub Envoi_mail()
Dim Ol As New Outlook.Application, Olmail As MailItem, CurrFile$, nom$, dest$, fin&, i&, a&, liste$, n&, nn&
Set Ol = New Outlook.Application
Set Olmail = Ol.CreateItem(olMailItem)
Application.ScreenUpdating = False
'nom = ThisWorkbook.FullName ' si un jour Jacky tu veux envoyer le fichier avec
With Feuil1
fin = Feuil1.Range("F" & Rows.Count).End(xlUp).Row
For i = 5 To fin
If .Cells(i, 5) <> "" And .Cells(i, 5).Font.ColorIndex = 3 Then dest = dest & .Cells(i, 6) & ";": nn = nn + 1
Next i
If nn = 0 Then MsgBox "Vous n'avez pas choisi de destinataire" & vbCrLf & _
"Vous devez avoir au moins une Croix rouge dans la liste" & vbCrLf & _
"La ou les Croix rouge sont les destinataires, les noirs sont le Copies Conformes", , "Destinataire de l'envoi": Exit Sub
1 For a = 5 To fin
If .Cells(a, 5) <> "" And .Cells(a, 5).Font.ColorIndex <> 3 Then liste = liste & .Cells(a, 6) & ";"
Next a
dest = Mid(dest, 1, Len(dest) - 1)
liste = Mid(liste, 1, Len(liste) - 1)
End With
With Olmail
.To = dest
.CC = liste
.Subject = "Message de Jacky"
.Body = "Bonjour c'est Jacky," & vbCrLf & "Et tu mets ce que tu veux....."
'.Attachments.Add nom 'Jacky si un jour tu modifies pour envoyer un fichier tu retires le ' en début de ligne
.Display
End With
End Sub |
Partager