Sub Envoi_Mail()
Dim OutApp As Object, OutMail As Object
Dim c, d, t, rng As Range, Debut$, Fin$
Dim R As String
Application.ScreenUpdating = False 'fige l'ecran
ActiveSheet.Shapes("Rectangle à coins arrondis 1").Visible = True 'retire le bouton commande
With Feuil7: Set d = .Range(.[D4], .[D65536].End(xlUp)) 'repere la matrice colonne D
ActiveSheet.Copy 'copie la feuille active
ActiveSheet.SaveAs ("C:\ ton chemin dossier impayés" & Format(Date, "dd-mm-yyyy") & ".xlsx") 'enregistre le nouveau classeur
R = "C:\ton chemin dossier impayés" & Format(Date, "dd-mm-yyyy") & ".xlsx" 'chemin du nouveau classeur pour lien par mail
For Each c In d 'boucle sur les adresse mail concernées
Set OutApp = CreateObject("Outlook.Application") 'connexion outlook
OutApp.Session.Logon 'ouvre la session mail
Set OutMail = OutApp.CreateItem(0) 'creation du mail vide
Debut = "Bonjour ," & Chr(13) & Chr(13) & "Ci-jointe la liste des impayés de la semaine avec les différentes actions à effectuer." & Chr(13) & Chr(13) & ""
Fin = "Bonne réception" & Chr(13) & Chr(13) & "Cordialement" & Chr(13) & Chr(13) & "ADB" 'phrase du corps du mail
On Error Resume Next
With OutMail 'propriete du mail
.To = c.Value 'adresse mail
.Subject = "Relance du " & Format(Date, "dd-mm-yyyy") 'sujet
.Body = Debut & Fin 'RangetoHTML'corps du mail
'.Display 'Pour voir à l'écran
.Attachments.Add R 'piece jointe
.Send 'Pour envoyer directement
End With
On Error GoTo 0
Set OutMail = Nothing 'vidage memoire du mail
Set OutApp = Nothing 'vidage memoire du mail
Suite:
Next
End With
Application.ScreenUpdating = True 'reactivation de l'ecran
MsgBox ("envoie de mail avec succes")
End Sub