XL 2019 Créer un mail avec liste de contact dans colonne excel avec Objet et corps de texte

cytise95

XLDnaute Junior
Bonsoir,
J'ai une macro sous exel 2019 d'insérer une liste de contact dans destinataire : "A.." ne fonctionne qu'avec Outlook mais pas dans gmail !
J'ai essayé de trouver une solution pour mettre les destinataire en : "CC...." mais rien trouvé de fonctionnel.
D'autre part j'aurai aimé aussi mettre un texte en objet et un corps de message qui serait indiqué dans une cellule excel

Sub MailFP()
'Mails pour liste Contacts
Dim Plage As Range, R As Range
Dim ListeMails As String

'Collecte les cellules contenant une croix en colonne L
Set Plage = Range("e2:e75").SpecialCells(xlCellTypeConstants, 2)
'Pour chaque cellule collectée
For Each R In Plage
'On récupère l'adresse mail en colonne précédente(D)
ListeMails = ListeMails & IIf(Len(ListeMails) > 0, ";", "") & R.Offset(0, -1).Text
Next R
'Envoi via OUTLOOK ---> A VERIFIER
ActiveWorkbook.FollowHyperlink "mailto:" & ListeMails

End Sub

Si quelqu'un à une idée pour améliorer cette macro j'en serai ravi
Merci
Christian
 

Pièces jointes

  • Essai_Mail_Auto.xlsm
    24.1 KB · Affichages: 19

OfficeNoob

XLDnaute Nouveau
Bonsoir, mes condoléances :/

Oui il n'y'a pas de retour si le mail ne part pas.
J'ai oublié de préciser qu'il fallait cocher une référence supplémentaire.

La voici :
1637964318845.png




Si cela ne suffit pas rend toi sur le lien suivant : https://support.google.com/mail/answer/7104828?hl=fr&visit_id=637735612870983428-575317415&rd=1



Compare le tableau d'instruction à celui-là :
1637964623383.png



Tiens moi au courant.

@+
 

krimoines

XLDnaute Nouveau
Bonsoir cytise95

Désolé de mon retard de réponse j'ai eu une semaine assez chargée :/
Voila j'ai fais mes recherches et j'ai trouvé un script qui fonctionne quasiment sans soucis.

Seul problème rencontré, quand j'envoi un mail via l'objet cdo google tire la sonnette d'alarme comme quoi l'application qui envoi le mail n'est pas sécurisé pour google, si j'allège la sécurité le mail par bien.

Avant d'aller plus loin est ce que tu utilise une adresse en gmail pour envoyer tes mails?

Dans le fichier que j'ai mis en PJ tu verras que j'ai ajouter dans l'onglet un champ pour activer ou désactiver l'envoi par google en renseignant oui ou non, bien sur si tu met non on utilise la méthode cdo.

Dit moi si cela te convient.

@+
Bonjour OfficeNoob je ne sait toujours pas comment joindre un fichier dans cet email par contre ça fonctione bien avec mon outlook quand je fait oui pas avec mon gmail!
bonne journée
 

cytise95

XLDnaute Junior
Je n'ai toujours pas réussi à envoyer un mail avec gmail.
J'ai essayé de remplacer les infos de @gmail par une adresse @free.fr, sans résultat.
J'ai trouvé une macro mais je ne sais pas s'il y a quelque chose d’intéressant dedans :

Sub test()
MailEnvoi "smtp.googlemail.com", True, "My.Mail@gmail.com", "Pasw", 465, 10, "My.Mail@gmail.com", "Vous.Mail@gmail.com", "Copy@gmail.com", "Suivi des modifications.", "tel truc a été modifile", ""
End Sub
Public Sub MailEnvoi(Serveur, Identify, User, PassWord, Port, Delay, Expediteur, Dest, DestEnCopy, Objet, Body, Pj)
' sub pour envoyer les mails
Dim msg
Dim Conf
Dim Config
Dim ess
Dim splitPj
Dim IsplitPj
Set msg = CreateObject("CDO.Message") 'pour la configuration du message
Set Conf = CreateObject("CDO.Configuration") ' pour la configuration de l'envoi
Dim strHTML

Set Config = Conf.Fields

' Configuration des parametres d'envoi
'(SMTP - Identification - SSL - Password - Nom Utilisateur - Adresse messagerie)
With Config
If Identify = True Then
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = User
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = PassWord
End If
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Port
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Serveur
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = Delay
.Update

End With


'Configuration du message
'If E_mail.Sign.Value = Checked Then Convert ServeurFrm.SignTXT, ServeurFrm.Text1

With msg
Set .Configuration = Conf
.To = Dest
.cc = DestEnCopy
.FROM = Expediteur
.Subject = Objet
'

.HTMLBody = Body '"<p align=""center""><font face=""Verdana"" size=""1"" color=""#9224FF""><b><br><font face=""Comic Sans MS"" size=""5"" color=""#FF0000""></b><i>" & body & "</i></font> " 'E_mail.ZThtml.Text
If Pj <> "" Then
splitPj = Split(Pj & ";", ";")

For IsplitPj = 0 To UBound(splitPj)
If Trim("" & splitPj(IsplitPj)) <> "" Then
.AddAttachment Trim("" & splitPj(IsplitPj))
End If
Next

End If
.Send 'envoi du message

End With
' reinitialisation des variables
Set msg = Nothing
Set Conf = Nothing
Set Config = Nothing

End Sub
 

Discussions similaires