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

[cytise95]

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

 

[cytise95]

Oui c'est super parfait.
Cela ouvre le mail et permet de le visualiser avant d'envoyer manuellement.
C'est différent mais pas gênant.
Merci beaucoup pour cette réalisation de macro

 

[OfficeNoob]

Ha oui oups, si tu préfère l'envoyer directement utilise ceci, regarde la partie à la fin
La fonction send sert à l'envoyer directement, display sert à l'ouvrir dans ton client mail

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
                       
                        ' Commente la fonction que tu ne souhaite pas utilisé
                        .Display        ' Créer et visualiser le mail
                        .Send            ' L'envoyer directement
                End With
               
                MsgBox "Le mail à bien été envoyé"
       
        End If
       
        Exit Sub
                 
End Sub

Content de t'avoir aider

@+

 

[cytise95]

Ok ... pour afficher ou non le mail avant envoi, j'utilise ou pas " .Display"
Vraiment parfait, plus tard j'essaierai de voir pour l'utiliser sur le portable avec une autre messagerie.
Énorme merci pour cette aide et patience.
Bonne soirée et bon Dimanche
Cordiales salutations

 

[OfficeNoob]

Avec une autre messagerie ce code ne fonctionnera pas.

Quand tu en seras là n'hésite pas à demander si tu coince

Bonne nuit et bon dimanche à toi aussi

Salutations

@+

 

[cytise95]

Bonsoir,
Encore moi. pour un souci de fonctionnalité dans mon fichier réel. Je pensais qu'en faisant les mêmes manip ça fonctionnerai..... et ben non
J'ai nommé ces cellules, puis copié la macro #17 et collé dans mon fichier d'utilisation.
J'ai un message d'erreur pour plusieurs lignes, je les avais mis en ligne de commentaire pour .... voir si le reste fonctionnait.
Les 3 lignes concernées par l'erreur sont :
'Dim oOutlook As Outlook.Application
'Dim oMailItem As Outlook.MailItem
'Call Preparer_outlook(oOutlook)

Je ne vois pas la cause de ce souci
Ça ne sent pas bon pour utiliser avec une autre messagerie

 

[OfficeNoob]

Bonsoir

Oui je pense que c'est la fameuse référence à cocher (voir post #2)
Pour l'autre messagerie il faudrait que je fasse des essais, sinon vois pour utiliser avec CDO.

@+

 

[cytise95]

En fait, j'ai triché en copiant l'onglet de test et le collant dans un nouvel onglet de mon fichier usuel.
En réaménageant les données, cela fonctionne ............. avec outlook
Je ne connais pas du tout "CDO" c'est quoi............... je vais chercher ce qu'il en est sur la toile
Si cela permet d'envoyer un mail avec une autre messagerie qu'Outlook ca devient intéresant

Bonne soirée
Cordialement

 

[krimoines]

Remplace la procédure MailFP dans ton fichier par ceci

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

@+

Bonsoir Office Noob moi aussi je suis interesser par ce fichier j'ai changé le code dans VB mais il y a une anomalie :
' Préparation d'Outlook
Call Preparer_outlook(oOutlook)

 

[OfficeNoob]

Bonsoir Office Noob moi aussi je suis interesser par ce fichier j'ai changé le code dans VB mais il y a une anomalie :
' Préparation d'Outlook
Call Preparer_outlook(oOutlook)

Bonsoir krimoines,

Probablement un problème de référence, va voir le post #2

 

[cytise95]

Bonsoir

Oui je pense que c'est la fameuse référence à cocher (voir post #2)
Pour l'autre messagerie il faudrait que je fasse des essais, sinon vois pour utiliser avec CDO.

@+

Je pensais que ma manip avait résolu le Pb. En fait c'était la macro de mon fichier test qui était utilisée en lien.
La macro n’est pas installée dans mon fichier usuel.

J'ai transféré la macro dans mon fichier mais elle ne fonctionne toujours pas.
La référence est toujours bien cochée

Cdlt

 

[cytise95]

J'ai coché comme ci dessous et cela fonctionne maintenant :

Je suis nul

 

[OfficeNoob]

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.

@+

 

[cytise95]

Bonsoir OfficeNoob,
Désolé de ce retard, j'étais perturbé pour cause d'obsèques.

J'ai essayé votre nouvelle macro. Il ne se passe rien, pas de message ni de création de mail.
Je vais tenter de comprendre ce qu'il se passe. Je vous tiens au courant.

 

[cytise95]

........... Rien a faire, j'ai indiqué mon gmail avec Mdp mais rien a faire.
Aucun message ne s'affiche ni la question pour "visualiser le mail".
Je ne vois vraiment pas ce qui "cloche" pour moi.

 

[cytise95]

J'ai omis de dire que si je met oui pour utiliser Outlook, tout fonctionne correctement.
Il n'y a donc qu'avec Gmail que cela ne fonctionne pas