Mail automatique selon personne choisie dans une liste
Bonjour
Avis aux âmes charitables et compétentes.
Je voudrais de l'aide pour une macro où, selon la personne choisie (colonne N, selon une liste), un mail lui soit envoyée avec dans le corps du message le nom d'une seconde personne (colonne A) et son prénom (colonne B), en indiquant la date d'envoie en colonne W pour éviter les envois répétés.
Je ne maîtrise pas les macros.
J'ai trouvé ceci, mais je ne comprends pas le code. Le principe est idéal :
Option Explicit
Sub TestMail()
Dim ShMail As Worksheet
Dim AireMail As Range
Dim CelluleMail As Range
Dim LigneDeTitre As Long
Dim DerniereLigne As Long
Dim ColAdresseMail As Long
Dim ColEnvoyerMail As Long
Dim ColMailEnvoye As Long
Dim OlApp As Outlook.Application
Dim OlItem As Outlook.MailItem
'Nécessite d'activer la référence "Microsoft Outlook xx.x Object Library"
Set ShMail = Sheets("Sheet1")
LigneDeTitre = 10
DerniereLigne = ShMail.Cells(ShMail.Rows.Count, 1).End(xlUp).Row
ColAdresseMail = 9
ColEnvoyerMail = 10
ColMailEnvoye = 11
If DerniereLigne = LigneDeTitre Then
MsgBox "Aucun client, fin de programme !", vbCritical, "Envoi des mails"
Set ShMail = Nothing
Exit Sub
End If
Set AireMail = ShMail.Range(ShMail.Cells(LigneDeTitre + 1, ColEnvoyerMail), ShMail.Cells(DerniereLigne, ColEnvoyerMail))
Set OlApp = New Outlook.Application
For Each CelluleMail In AireMail
If CelluleMail = "Oui" And CelluleMail.Offset(0, ColAdresseMail - ColEnvoyerMail) <> "" Then
Set OlItem = OlApp.CreateItem(olMailItem)
With OlItem
.To = CelluleMail.Offset(0, ColAdresseMail - ColEnvoyerMail) '"NomPrenom(arrowbase)mail(point)fr" 'mettre
MsgBox CelluleMail.Offset(0, ColAdresseMail - ColEnvoyerMail)
.Subject = "Le titre du message"
.Body = "test message mail avec mon message" & vbLf & _
"Cordialement" & vbLf & "emetteur(arrowbase)mail(point)fr"
.Display
.Save
.Send
End With
CelluleMail.Offset(0, ColMailEnvoye - ColEnvoyerMail) = Format(Date, "mm/dd/yyyy")
CelluleMail = ""
End If
Set OlItem = Nothing
Next CelluleMail
Set OlApp = Nothing
Set AireMail = Nothing
Set ShMail = Nothing
End Sub
Une fois cela terminé, je pourrais rendre mon document. A votre bon coeur
Je me permets de relancer. J'ai vraiment besoin de ce code.
Bonne journée
Je ne progresse pas. Je sais envoyer des mails des adresses définies mais pas à des adresses variables sous condition que cela n'ai pas déjà été fait.
Oui, j'ai un PC chez moi mais aussi des enfants. Et quand tu sors d'une journée de 14 h, t'as pas forcement envie de retravailler sachant que ce n'est pas tes fonctions