Macro Mail Outlook avec choix pour destinataire

Bonsoir le forum,

Voici un code qui permet de générer un mail

Sub Envoyer_Mail_Outlook()

Dim ObjOutlook As New Outlook.Application

Dim oBjMail

Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application

Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")

If Nom_Fichier = "Faux" Then Exit Sub

With oBjMail

.Display ' Ici on peut supprimer pour l'envoyer sans vérification

.To = "LeClient@gmail.com" ' le destinataire

.CC "" 'adresse destinataire en copie

'.BCC = "" 'adresse destinataires pour info

.Subject = "OPTIMUM Demande de création - Suppression " ' l'objet du mail

.HTMLBody = "Pourriez-vous S V P traîter les demandes de création et de suppression de ce jour " 'le corps du mail

.BodyFormat = olFormatHTML 'signature outlook

.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier

.Fields("urn:schemas:mailheader:return-receipt-to") = "" 'adresse pour recevoir un accusé de réception. En général c'est l'adresse de l'expéditeur.

'.Display ' Ici on peut supprimer pour l'envoyer sans vérification

.Send

End With

ObjOutlook.Quit

Set oBjMail = Nothing

Set ObjOutlook = Nothing

End Sub

Le destinataire ne change pas, le texte ne change pas, j'ai la possibilité de choisir une pièce jointe,

mais j'ai besoin de pouvoir choisir et ajouter plusieurs destinataires en copie en les choisissant dans une liste (sélection décalée) :

soit

tartentenpion => xxxx@gmail.fr

paparazzi => xxxxxx@gmail.com...

D'avance je vous remercie pour votre aide et votre disponibilité

Bonjour,

Remplace

.To = "LeClient@gmail.com" ' le destinataire

par

.To = Range("destinataire").Value ' le destinataire

Dans une feuille, et dans une cellule nommée destinataire, tu peux mettre une liste déroulante

Bonsoir le forum

Bonsoir Steelson

Merci pour ton aide et ton conseil.

Effectivement je vais essayé comme ça, mais du coup je vais créer un "ListBox" afin de cocher les adresses que j'ai besoin, et les concatener dans une cellule avant de les importer dans mon mail.

Je vais de ce pas ouvrir un autre post afin de savoir comment concatener plusieurs choix dans un "ListBox"

Merci pour ton aide et ta disponibilité

Bonsoir, je viens d'appliquer le code sur un bouton.

PAr contre je ne peux que selectionner des fichiers excel.

Comment puis-je rajouter n'importe quel pièce jointe se trouvant sur mon pc?

Le code ci-dessous fonctionne tres bien, mais je souhaite pouvoir envoyé toutes sortes de fichier.

quand j'efface la ligne

Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
If Nom_Fichier = "Faux" Then Exit Sub

ca me demande bien de choisir un fichier et n'importe quel type. mais quand je clique dessus pour le selectionner, il m'ouvre l'email, mais je n'ai pas la pièce jointe. Une idée??

Sub Envoyer_Mail_Outlook()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = Application.GetOpenFilename("Fichier excel (*.xls;*.xlsx;*.xlsm), *.xls;*.xlsx;*.xlsm")
If Nom_Fichier = "Faux" Then Exit Sub

With oBjMail
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.To = "LeClient@gmail.com" ' le destinataire
.CC "" 'adresse destinataire en copie
'.BCC = "" 'adresse destinataires pour info
.Subject = "OPTIMUM Demande de création - Suppression " ' l'objet du mail
.HTMLBody = "Pourriez-vous S V P traîter les demandes de création et de suppression de ce jour " 'le corps du mail
.BodyFormat = olFormatHTML 'signature outlook
.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
.Fields("urn:schemas:mailheader:return-receipt-to") = "" 'adresse pour recevoir un accusé de réception. En général c'est l'adresse de l'expéditeur.
'.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.Send
End With
ObjOutlook.Quit
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub

B.A. BA du troubleshooting = fais unMsgBox Nom_Fichierou un debug.print Nom_Fichier avant le .Attachments.Add Nom_Fichier pour voir ce que contient la variable Nom_Fichier

Ouahouuu j'ai pas trop compris la.

mets ceci :

' ajout temporaire de cette instruction pour savoir ce que contient Nom_Fichier (chemin, nom, extension)
MsgBox Nom_Fichier

With oBjMail
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.To = "LeClient@gmail.com" ' le destinataire
.CC "" 'adresse destinataire en copie
'.BCC = "" 'adresse destinataires pour info
.Subject = "OPTIMUM Demande de création - Suppression " ' l'objet du mail
.HTMLBody = "Pourriez-vous S V P traîter les demandes de création et de suppression de ce jour " 'le corps du mail
.BodyFormat = olFormatHTML 'signature outlook
.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
.Fields("urn:schemas:mailheader:return-receipt-to") = "" 'adresse pour recevoir un accusé de réception. En général c'est l'adresse de l'expéditeur.
'.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.Send
End With

magnifiqueeeeeeeeeeeeeeeeeeee

Et alors, est-ce que Nom_Fichier contient ce que tu souhaites ?

Ca fonctionne tres bien.

J'ai remodifier le code à ma convenance. quand je clique dessus, comment faire pour qu'il m'ouvre un dossier precis.

ex: G:\drop\gestion\devis

le voici

Sub envoiemail()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = Application.GetOpenFilename
If Nom_Fichier = "Faux" Then Exit Sub

MsgBox Nom_Fichier

With oBjMail
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.To = "ECRIRE EMAIL CLIENT" ' le destinataire
'.BCC = "" 'adresse destinataires pour info
.Subject = "ECRIRE OBJET " ' l'objet du mail
.HTMLBody = "ECRIRE LE CORPS DU MAIL " 'le corps du mail
.BodyFormat = olFormatHTML 'signature outlook
.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub

Bonsoir le forum

Bonsoir pouns94

En fait tout est dans le code

Tu commente

'Nom_Fichier = Application.GetOpenFilename
'If Nom_Fichier = "Faux" Then Exit Sub

et u vas à la ligne

.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier

pour remplacer "C:\Data..." en le décommentant

merci bcp

Tout compte voici mon code.

Le seul soucis, c'est que je peux selectionner qu'un seul fichier, ctrl enfoncé je ne peux pas selectionner plusieurs fichier. toujours un seul.

Une idée?

Sub envoiemail()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = Application.GetOpenFilename
If Nom_Fichier = "Faux" Then Exit Sub

MsgBox Nom_Fichier

With oBjMail
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.To = "ECRIRE EMAIL CLIENT" ' le destinataire
'.BCC = "" 'adresse destinataires pour info
.Subject = "ECRIRE OBJET " ' l'objet du mail
.HTMLBody = "ECIRE LE CONTENU DU MAIL " 'le corps du mail
.BodyFormat = olFormatHTML 'signature outlook
.Attachments.Add Nom_Fichier '"G:\Drop" ' ou Nomfichier
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub

Une idée?

Tu peux mettre plusieurs fichiers comme ceci :

.Attachments.Add Nom_Fichier(1)
.Attachments.Add Nom_Fichier(2)
.Attachments.Add Nom_Fichier(3)

et tu fais une boucle du genre

i=0
Do 
i = i+1
Nom_Fichier(i) = Application.GetOpenFilename
Loop While Nom_Fichier(i) <> ""

pour sélectionner un à un, sinon pour sélectionner globalement :

Nom_Fichier = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx*), *.xlsx*", Title:="Selection de tous les fichiers", MultiSelect:=True)

à tester et adapter.

Je suis desolé mais je n'arrive vraiment pas a comprendre où mettre la phrase pour que ca me propose les elements present sur mon bureau par exemple.

Ci-dessous le code.

Sub envoiemail()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = Application.GetOpenFilename
If Nom_Fichier = "Faux" Then Exit Sub

MsgBox Nom_Fichier

With oBjMail
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.To = "ECRIRE EMAIL CLIENT" ' le destinataire
'.BCC = "" 'adresse destinataires pour info
.Subject = "ECRIRE OBJET " ' l'objet du mail
.HTMLBody = "ECRIRE LE CONTENU DU MAIL " 'le corps du mail
.BodyFormat = olFormatHTML 'signature outlook
.Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing
End Sub

Sub envoiemail()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

Nom_Fichier = Application.GetOpenFilename(Title:="Selection de tous les fichiers", MultiSelect:=True)
If Not IsArray(Nom_Fichier) Then Exit Sub

With oBjMail
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.To = "ECRIRE EMAIL CLIENT" ' le destinataire
'.BCC = "" 'adresse destinataires pour info
.Subject = "ECRIRE OBJET " ' l'objet du mail
.HTMLBody = "ECRIRE LE CONTENU DU MAIL " 'le corps du mail
.BodyFormat = olFormatHTML 'signature outlook
For i = 1 To UBound(Nom_Fichier)
.Attachments.Add Nom_Fichier(i) '"C:\Data\essai.txt" ' ou Nomfichier
Next
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing

End Sub

Super merci je peux enfin selectionner plusieurs piece jointe.

Dans cette phrase :

.Attachments.Add Nom_Fichier(i) '"C:\Data\essai.txt" ' ou Nomfichier

ou dois-je place mon chemin d'accès par defaut ca m'evite de parcourir tout mon disque dur pour allez chercher ma piece jointe.?

Mon chemin par defaut est g:\Drop\JNN SE\Devis

avec ChDir

Sub envoiemail()
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier

Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)

ChDir "G:\Drop\JNN SE\Devis"
Nom_Fichier = Application.GetOpenFilename(Title:="Selection de tous les fichiers", MultiSelect:=True)
If Not IsArray(Nom_Fichier) Then Exit Sub

With oBjMail
.Display ' Ici on peut supprimer pour l'envoyer sans vérification
.To = "ECRIRE EMAIL CLIENT" ' le destinataire
'.BCC = "" 'adresse destinataires pour info
.Subject = "ECRIRE OBJET " ' l'objet du mail
.HTMLBody = "ECRIRE LE CONTENU DU MAIL " 'le corps du mail
.BodyFormat = olFormatHTML 'signature outlook
For i = 1 To UBound(Nom_Fichier)
.Attachments.Add Nom_Fichier(i) '"C:\Data\essai.txt" ' ou Nomfichier
Next
End With
Set oBjMail = Nothing
Set ObjOutlook = Nothing

End Sub