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

C

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
Trier par date Trier par votes
OfficeNoob

OfficeNoob

XLDnaute Nouveau
Bonsoir cytise, le forum

Tester dans un de mes fichiers et le code est fonctionnel, ce code nécessite de cocher une référence supplémentaire dans le menu "Outils" de l'éditeur VBA.
"Outils" ==> "Références" ==> Chercher dans la liste "Microsoft Outlook 16.0 Object Library" et le cocher, ceci te donnera accès à l'objet Outlook utilisé ci bas

VB: 
Public Sub Envoyer_mail(ByVal sujet As String, ByVal destinataire As String, ByVal contenu As String)

        Dim oOutlook As Outlook.Application
        Dim oMailItem As Outlook.MailItem
        Dim ws As Worksheet
       
        Set ws = Sheets("Paramètres fichier")
               
        ' Appel de la procédure pour la préparation de Outlook
        Call Preparer_outlook(oOutlook)
       
        ' On tente de créer le mail et son contenu
        On Error Resume Next
                Set oMailItem = oOutlook.CreateItem(0)
               
                ' Si une erreur à la création est détecté on affiche un message d'aide
                If Err.Number > 0 Then
               
                        MsgBox "Erreur lors de l'envoi du mail"
                     
                ' Sinon on affiche un message d'indication pour confirmer l'envoi du mail
                Else
               
                        MsgBox "Le mail à bien été envoyé"
                       
                        ' Ajout destinataire, sujet et contenu au corps du mail et envoi
                        With oMailItem
                                .To = "Indiquer les destinataires"
                                .CC = "Indiquer les CC"
                                .Subject = "Indiquer le sujet"
                                .Attachments.Add "Lien du fichier joint"
                                .BodyFormat = olFormatHTML    'Choix du format du corps du mail, ici HTML, format texte disponible aussi
                                .HTMLBody = "<html><p>" & contenu & "</p></html>"
                                .Send
                        End With
               
                End If

End Sub





' /// Procédure utilisée pour l'ouverture et la préparation de l'application Outlook

Private Sub Preparer_outlook(ByRef oOutlook As Object)
       
        ' On tente de lancer l'application Outlook
        On Error Resume Next
                Set oOutlook = GetObject(, "Outlook.Application")
               
                ' Si celle-ci ne se lance pas on raz l'erreur et on retente un lancement
                If Err.Number > 0 Then
                       
                        Err.Clear
                        Set oOutlook = CreateObject("Outlook.application")
                       
                        ' Si celle-ci ne se lance toujours pas affichage d'un message d'erreur
                        If Err.Number > 0 Then
                                MsgBox "Erreur lors de la préparation d'outlook"
                                Exit Sub
                        End If
                       
                End If

End Sub
 
Vote positif 0 Vote négatif
C

cytise95

XLDnaute Junior
Bonjour,
Merci beaucoup de votre réponse.
Impossible de créer un mail et aucun message d'erreur.
J'ai vérifié "Microsoft Outlook 16.0 Object Library" qui était déjà coché.
Je ne sais pas si cette macro voit bien mon fichier excel afin de prendre en compte que les mails qui ont un "X" à droite.
Cdlt
 
Vote positif 0 Vote négatif
OfficeNoob

OfficeNoob

XLDnaute Nouveau
Bonjour,

J'ai intégré le code dans ton fichier, l'envoi des mails est fonctionnel de mon côté en tout cas.
Réessayer et dite moi si cela fonctionne maintenant :)

J'ai mis un point d'arrêt après le traitement de "listeMails", les mails précédés d'une croix sont bien récupérés dans la variable.

@+
 

Pièces jointes

  • Essai_Mail_Auto_E1.xlsm
    22.3 KB · Affichages: 10
Vote positif 0 Vote négatif
C

cytise95

XLDnaute Junior
Merci. Cela fonctionne bien. Cependant j'ai encore quelques questions :

J'ai essayé de remplacer ".To = ListeMails" par ".CCi" et non pas CC comme j'avais indiqué plus haut.
J'ai le message "le mail a bien été envoyé" mais aucune trace d'envoi

Concernant : ".Subject = "Sujet mail" " n'est-il pas possible d'avoir un objet personnalisé a chaque envoi, genre prendre les infos dans une cellule d'excel.

Pour le PDF à joindre '.Attachments.Add "Lien du fichier joint" il faut changer le lien a chaque envoi ou est-il possible de sélectionner le lien dans une cellule d'excel également.

Pas simple les macro pour un non initié.
Merci encore
 

Pièces jointes

  • Essai_Mail_Auto-cv_E1-2.xlsm
    26.6 KB · Affichages: 2
Vote positif 0 Vote négatif
OfficeNoob

OfficeNoob

XLDnaute Nouveau
Re,

Et voici le fichier corrigé, effectivement pour passer un destinataire le paramètre est BBC, bien joué.

Pour le sujet, PJ et corps du mail j'ai pris comme source les cellules K7,8 et 9 (j'ai nommé ces cellules pour plus de souplesse.
Je ne suis pas encore forcément très à l'aise avec les liens de navigation dans les dossiers mais pour ne pas avoir de problème je te conseille de mettre le lien de la pièce jointe en entier. (pense bien à remplacer en K8 le lien que j'ai utilisé en test)

Dit moi si cela te convient.

@+
 

Pièces jointes

  • Essai_Mail_Auto-cv_E1-3.xlsm
    26.9 KB · Affichages: 8
Vote positif 0 Vote négatif
C

cytise95

XLDnaute Junior
Désolé j'ai du m’absenter quelques heures,

J'ai essayé cette nouvelle version, c'est parfait pour l'objet et le corps de mail.
j'ai mis le lien pour accéder au PDF mais rien a faire il n'est pas pris en compte en l’occurrence "C:\data\_____TEST FP\Test PJ envoi mail auto.pdf".
J'ai essayé de l'ouvrir en direct d'excel j’obtiens le message de sécurité ci dessous.
Je vais essayer de voir si c'est un paramètre de sécurité .. pas gagné

toujours un grain de sable qui bloque.............

A part cela, la macro répond parfaitement à mon attente.
Merci beaucoup de cette aide précieuse.
 

Pièces jointes

  • Capture d’écran 2021-11-20 203158.png
    Capture d’écran 2021-11-20 203158.png
    12 KB · Affichages: 36
Vote positif 0 Vote négatif
C

cytise95

XLDnaute Junior
j'ai fermé le fichier (car j'ai essayé des "bidouilles" en vain et ré-ouvert ton fichier.
J'ai remis mon lien de PDF dans excel et refait une autre corps de mail.
et la ça fonctionne, je ne comprend pas le blocage précédent.
Cependant le PDF s'incruste dans le corps du mail

J'espère que cela correspond à ton attente
 

Pièces jointes

  • Essai_Mail_Auto-cv_E1-5.xlsm
    26.9 KB · Affichages: 9
  • Capture d’écran 2021-11-20.png
    Capture d’écran 2021-11-20.png
    8.8 KB · Affichages: 35
Vote positif 0 Vote négatif
OfficeNoob

OfficeNoob

XLDnaute Nouveau
Chez moi la PJ ce met bien au sommet du mail

1637444275120.png


Qu'elle logiciel utilise tu pour consulter tes mails? Outlook?
 
Vote positif 0 Vote négatif
OfficeNoob

OfficeNoob

XLDnaute Nouveau
Remplace la procédure MailFP dans ton fichier par ceci

VB: 
Sub MailFP()

        ' Mails pour liste Contacts pour FP
        Dim Plage As Range, R As Range
        Dim corpsMail As Range
        Dim pjMail As Range
        Dim sujetMail As Range
        Dim contenu As String
        Dim ListeMails As String
        Dim oOutlook As Outlook.Application
        Dim oMailItem As Outlook.MailItem
        
        Set Plage = Nothing
        Set corpsMail = ActiveSheet.Range("Corps_mail")
        Set sujetMail = ActiveSheet.Range("Sujet_mail")
        Set pjMail = ActiveSheet.Range("PJ_mail")
        
        ' Si la recherche de cellule contenant un caractère ne renvoi rien on sort de la procédure
        On Error Resume Next
                Set Plage = ActiveSheet.Range("E2:E75").SpecialCells(xlCellTypeConstants, 2)
        
        If Plage Is Nothing Then
                MsgBox "Aucun destinataire n'est sélectionné"
                Exit Sub
        End If
        
        ' Pour chaque cellule collectée on récupère l'adresse mail en colonne précédente(D)
        For Each R In Plage
                ListeMails = ListeMails & IIf(Len(ListeMails) > 0, ";", "") & R.Offset(0, -1).Text
        Next R
        
        ' On sort de la procédure si listeMails ne contient rien
        If ListeMails = "" Then
                MsgBox "La récupération des adresses mails a échoué"
                Exit Sub
        End If
        
        ' Préparation d'Outlook
        Call Preparer_outlook(oOutlook)
        
        On Error Resume Next
                Set oMailItem = oOutlook.CreateItem(0)
        
        ' Si une erreur à la création est détecté on affiche un message d'aide
        If Err.Number > 0 Then
        
                MsgBox "Erreur lors de l'envoi du mail"
        
        ' Sinon on affiche un message d'indication pour confirmer l'envoi du mail
        Else
        
                ' Ajout destinataire, sujet et contenu au corps du mail et envoi
                With oMailItem
                        .BCC = ListeMails
                        .Subject = sujetMail.Value
                        .BodyFormat = olFormatPlain
                        .Body = corpsMail.Value
                        
                        If Not Dir(pjMail.Value) = "" Then
                                .Attachments.Add pjMail.Value
                        Else
                                MsgBox "L'attachement de la PJ a échouer"
                                Exit Sub
                        End If
                        
                        .Display
                End With
                
                MsgBox "Le mail à bien été envoyé"
        
        End If
        
        Exit Sub
                   
End Sub

La PJ se plaçait n'importe ou car le format du corps du mail était en texte enrichi, je les remis en format "plein", je me suis aussi permis de faire un peu le ménage dans le code.
J'ai aussi rajouter un traitement supplémentaire avant la recherche des croix dans la colonne correspondante, effectivement si rien n'était coché l'exécution plantée.

Dit moi si cela te convient

@+
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

B
  • Question
XL 2016 VBA - Ajout de consignes dans le corps d'un mail
Réponses
3
Affichages
200
kiki29
kiki29
A
  • Résolu(e)
XL 2021 Macro de création mail de relance avec référence cellules
Réponses
4
Affichages
577
arnoldbrice19
A
D
  • Question
XL 2013 envoie tableau dans corp du mail vba
2
Réponses
26
Affichages
2 K
David62800
D
O
  • Question
Microsoft 365 Excel [VBA]. Erreur d’exécution 424 Objet requis sur une concaténation
Réponses
3
Affichages
404
Oneida
Oneida
W
  • Question
XL 2016 Joindre par mail un fichier.pdf personnalité selon le prénom trouvé dans le titre du pdf
Réponses
8
Affichages
604
TooFatBoy
TooFatBoy
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
638
Mody200
M
V
  • Question
Microsoft 365 Générer un mail Outlook via Excel si modification colonne Excel
Réponses
1
Affichages
1 K
gig83500
G
B
  • Résolu(e)
XL 2016 Selectionner date la plus proche au supérieur de la date d'aujourd'hui
Réponses
5
Affichages
1 K
babacool22
B
J
  • Question
Excel -VBA : Envoie plusieurs partie du même tableau dans un corps mail en fonction de certaines conditions
Réponses
0
Affichages
1 K
JBIK
J
M
  • Question
XL 2013 VBA-Envoyer par email "Plage de cellules collée dans un nouveau classeur en gardant formules de certaines cellules
Réponses
2
Affichages
857
MONTREAL2020
M

Membres actuellement en ligne

15 membres et 175 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 132
Messages
2 116 591
Membres
112 799
dernier inscrit
valdeff