Envoi d' un mail à une liste de destinataires variables
Bonjour,
Je galère depuis plusieurs jours sur le forum pour adapter les réponses déjà postées sur le sujet à mon problème mais sans succès .
Alors une âme charitable pourrait-elle m' aider?
En feuil1 de B1 à B10 j' ai des noms ( N1,N2...N10)
de C1 à C10 j' ai les adresses mail correspondantes ( M1,...M10)
de D1à Dx j' ai les noms des x personnes permis les 10 concernées par l' envoi du mail ( résultat d'un autre programme, x<=10)
Je souhaite par une macro , envoyer un mail à ces x personnes avec une pièce jointe qui sera la feuil2 seule (une copie image d' une partie de la feuil 1du classeur).
Voilà , merci pour votre aide
Cptbru
Quelque chose comme ceci ...
Option Explicit
Sub envoi()
Dim messagerie As Object
Dim email As Object
Dim cel As Range
Set messagerie = CreateObject("Outlook.Application")
For Each cel In Range("D1:D" & Range("D1").End(xlDown).Row)
Set email = messagerie.CreateItem(0)
With email
.to = cel
.Subject = "mettre ici le titre du mail"
.body = "ici le contenu de la feuille 2"
.display ' à remplacer par .send si ok
End With
Set email = Nothing
Next cel
Set messagerie = Nothing
End SubBonjour Steelson et merci pour ta réponse
Comme je l' ai mentionné dans mon texte,ce ne sont pas des adresses mail qui sont en D mais des noms et je n arrive pas à les associer aux adresses mail correspondantes qui se trouvent en C1 à C10
Est il aussi possible de n' envoyer qu' un seul mail aux x destinataires....
Merci
alors ...
Option Explicit
Sub envoi()
Dim messagerie As Object
Dim email As Object
Dim cel As Range
Dim dest as String
dest = ""
Set messagerie = CreateObject("Outlook.Application")
For Each cel In Range("C1:C" & Range("C1").End(xlDown).Row)
dest = dest + cel.value + ";"
Next cel
Set email = messagerie.CreateItem(0)
With email
.to = dest
.Subject = "mettre ici le titre du mail"
.body = "ici le contenu de la feuille 2"
.display ' à remplacer par .send si ok
End With
Set email = Nothing
Set messagerie = Nothing
End SubOk super pour l'envoi d'un seul mail aux destinataires.
Mais désole de prendre de ton temps, je te ré explique le problème qui me
bloque:
Un autre programme vient me remplir en D1..Dx les NOMS des destinataires de mon mail et pas leurs adresses mail.
Il faudrait que ta macro aille chercher leurs adresses mail dans la colonne C .
Exemple:
En B1à B10 : Pierre Paul Luc ...Roger
En C1à C10 : pierre@ paul@ luc@ .... Roger@ Un autre programme me dit que je dois envoyer un mail à Paul et Roger donc
En D1 j'ai Paul
En D2 j ai Roger
Je voudrais que la macro envoie un mail à Paul et Roger AVEC UNE PIÈCE JOINTE qui sera la feuille 2 du classeur.
MERCI ENCORE POUR TON AIDE , ÇA FAIT PLUSIEURRES SEMAINES QUE J ESSAYE.....
J'ai bien compris la position des noms et des adresses mail ...
je te propose si tu veux aller plus loin de poster un bout de fichier car plusieurs solutions sont possibles
ok ci joint un fichier
essaie ceci :
Option Explicit
Sub envoi()
Dim messagerie As Object
Dim email As Object
Dim cel As Range
Dim dest as String
dest = ""
Set messagerie = CreateObject("Outlook.Application")
For Each cel In Range("B2:B" & Range("B1").End(xlDown).Row)
if cel.offset(0,2).value <> "" then dest = dest + cel.offset(0,1).value + ";"
Next cel
Set email = messagerie.CreateItem(0)
With email
.to = dest
.Subject = "mettre ici le titre du mail"
.body = "ici le contenu de la feuille 2"
.display ' à remplacer par .send si ok
End With
Set email = Nothing
Set messagerie = Nothing
End Subje te laisse ajouter la feuille2
Désolé ça ne fonctionne toujours pas Steelson même en remplaçant (B1 par B2 dans ton dernier envoi)
L'ordre des destinataires que l' on obtient n' est pas le bon.
Dans l exemple que je t'ai donné, si tu peux me transcrire le séquence suivante en langage Vba je pense que ça irait:
´´ pour chaque cellule non vide de D2àD10
Compare sa valeur à B2
Si elle est differente alors
Compare à B3
Si elle est differente alors
Compare à B4
....etc
Compare à B(2+x) jusqu'à qu'il trouve le meme nom (D2 =B(2+x))
Si c est le cas alors le 1er dest sera en C(2+x)
Recommence pour les autre cellules non vide de D3à D10
Qu' en penses tu ?,,,
Meme si ça me devait pas fonctionner je ne t' ennuierai pas davantage, tu m'as déjà été d' un grand secours dans la compréhension de mon problème !!
Désolé, j'ai été un peu vite et j'ai zappé le fait que ces personnes appartenaient à la liste en B
Le fait que tout soit en tableau m'a trompé
Bon il suffit de rajouter un Find
Option Explicit
Sub envoi()
Dim messagerie As Object
Dim email As Object
Dim cel1 As Range
Dim cel2 As Range
Dim dest As String
Dim Reponse As String
dest = ""
For Each cel1 In Range("D2:D" & Range("D1").End(xlDown).Row)
Set cel2 = Columns("B").Find(cel1.Value, Range("B1").End(xlDown), xlValues, xlWhole)
If Not cel2 Is Nothing Then
dest = dest + cel2.Offset(0, 1).Value + ";"
End If
Next
Set messagerie = CreateObject("Outlook.Application")
Set email = messagerie.CreateItem(0)
With email
.to = dest
.Subject = "mettre ici le titre du mail"
.body = "ici le contenu de la feuille 2"
.display ' à remplacer par .send si ok
End With
Set email = Nothing
Set messagerie = Nothing
End SubTu es matinal Steelson!
Non ça bogue à la ligne en dessous de for each
Tu as dimensionné reponse et je ne le vois pas.
Mais en lisant les cours VBA , j ai adapté un code qui marche:
For each cel In Range("D2:D" & Range("D2").End (x1down).Row)
Select Case cel
Case is = cel.Offset(0,-2).Value
dest = dest + cel.Offset(0,-1).Value + ";"
Case is = cel.Offset(1,-2).Value
dest = dest + cel.Offset(1,-1).Value + ";"
....etc
End Select
Next cel
Un dernier conseil, comment fais tu pour envoyer en pu la Feuil2 SEULE du classeur??
Merci bcp
puise ce dont tu as besoin ci-dessosu et adapte-le :
Sub envoi()
...
Dim nompdf As String
nompdf = Environ("Temp") & "\" & "fichier test"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set messagerie = CreateObject("Outlook.Application")
Set email = messagerie.CreateItem(0)
With email
...
.Attachments.Add nompdf & ".pdf"
...
End With
...
kill nompdf & ".pdf"
End SubOk super en pdf
Ça fonctionne très bien
Merci beaucoup pour ton aide
A bientôt peut être
Cptbru
Parfait !
L'essentiel est que tu puisses reprendre le code, le comprendre et l'adapter en toute circonstance !