email excel

[gothc]

Bonjour j'ai une macro qui fonctionne très bien mais je cherche a pouvoir envoyer cette email a plusieurs personne et de pouvoir choisir la personne à qui je l'envoi env 15 personnes

Merci de votre aide

Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim Fichier As String
Dim SourceWb As Workbook

Set SourceWb = ActiveWorkbook
Fichier = ThisWorkbook.Path & Application.PathSeparator & "j1.xls"

SourceWb.SaveCopyAs Fichier

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("") = True
.Item("") = 1
.Item("") = "planningdivonne01@gmail.com"
.Item("") = "mot passe"
.Item("") = "smtp.gmail.com"

.Item("") = 2
.Item("") = 465
.Update
End With

strbody = "Bonjour, Voici le fichier . Merci!"

With iMsg
Set .Configuration = iConf
.to = "email1@gmail.com"
.CC = "email2@gmail.com"
.BCC = ""
' Note: The reply address is not working if you use this Gmail example
' It will use your Gmail address automatic. But you can add this line
' to change the reply address .ReplyTo = "Reply@something.nl"
.From = """mon Nom"" <email>"

.Subject = "fichier"
.TextBody = strbody

.AddAttachment Fichier
.Send

Kill Fichier



End With
End Sub

 

[Staple1600]

Bonsoir le fil, le forum

@gothc
Où est la difficulté?
Cette question a déjà été traitée entre 30 et 49 fois sur le forum, surtout les jours de grand vent mais jamais les années bissextiles
Tu trouveras réponse à ta question dans les archives du forum (accessible avec la loupe en haut à droite)

Un indice: le ; te sera d'un grand secours
Surtout si tu l'utilises comme suit
Dim Desti$
Desti="to@to.fr;ti@ti.fr;za@za.fr"
...
.To="email1@mail.fr"
.CC=Desti

 

[gothc]

Re bonsoir le forum
je vais simplifier ma demande par

sur la feuil 1 dans la colonne A avoir une liste email destinataire
Merci

 

[Staple1600]

Re

La réponse est la même
De nombreux exemples dans les archives du forum.
A titre illustratif

Sub Macro1()
Dim t, Desti$
With Range("A1:A20")
.FormulaR1C1 = "=""email""&ROW()&""@toto.fr"""
.Value = .Value
t = .Value
End With
'c'est ici que cela peut t’intéresser
Desti = Join(Application.Transpose(t), ";")
MsgBox Desti
End Sub

 

[gothc]

Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim Fichier As String
Dim SourceWb As Workbook

Set SourceWb = ActiveWorkbook
Fichier = ThisWorkbook.Path & Application.PathSeparator & "j1.xls"

SourceWb.SaveCopyAs Fichier

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("") = True
.Item("") = 1
.Item("") = "planningdivonne01@gmail.com"
.Item("") = "mot passe"
.Item("") = "smtp.gmail.com"

.Item("") = 2
.Item("") = 465
.Update
End With

strbody = "Bonjour, Voici le fichier . Merci!"

With iMsg
Set .Configuration = iConf
.to = "email1@gmail.com"
.CC = "email2@gmail.com"
.BCC = ""
' Note: The reply address is not working if you use this Gmail example
' It will use your Gmail address automatic. But you can add this line
' to change the reply address .ReplyTo = "Reply@something.nl"
.From = """mon Nom"" <email>"

.Subject = "fichier"
.TextBody = strbody

.AddAttachment Fichier
.Send

Kill Fichier



End With
End Sub

 

[Staple1600]

Re

Plutôt que de remettre ton code* une seconde fois
Voir, comprendre, tester et adapter la macro du message#4

*: ou plutôt le code de Ron de Bruin (je qu'on se baigne dans les mêmes sources )

 

[gothc]

Merci Ce lien n'existe plus je vais regarder sur le forum si je trouve

 

[Staple1600]

Re

???
La macro que j'ai déposé dans le message#4 ne t'a pas mis sur la piste?
Quel est ton niveau de maîtrise de VBA?

 

[Staple1600]

Re

Ta macro amendée selon mes différentes suggestions

Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object, iConf As Object, strbody$, Fichier$
Dim Flds As Variant, SourceWb As Workbook, t, Destinataires$
Set SourceWb = ActiveWorkbook
Fichier = ThisWorkbook.Path & Application.PathSeparator & "j1.xls"
SourceWb.SaveCopyAs Fichier
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.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") = "planningdivonne01@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mot passe"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
t = Range("A1:A15")
Destinataires = Join(Application.Transpose(t), ";")
strbody = "Bonjour, Voici le fichier . Merci!"
With iMsg
Set .Configuration = iConf
.to = "email1@gmail.com"
.CC = Destinataires
.BCC = ""
.From = """mon Nom"" <email>"
.Subject = "fichier"
.TextBody = strbody
.AddAttachment Fichier
.Send
Kill Fichier
End With
End Sub

 

[gothc]

Merci je viens de faire un test la macro fonctionne
un grand merci pour votre aide Ce lien n'existe plus
bonne soirée a vous

 

[gothc]

bonjour j'ai un petit problème les personnes reçoivent bien l'émail mais dans la boite spam
comment peut on évité le problème
merci

 

[Staple1600]

Bonsoir le fil, le forum

Et comme cela?
Set .Configuration = iConf
.to =Destinataires
.CC =""
.BCC = ""
ou alors comme cela?
Set .Configuration = iConf
.to =""
.CC =""
.BCC = Destinataires

 

[gothc]

bonjour le fil apres 2 tests avec les deux versions ça fonctionne pas j'ai toujours l'émail dans les Spams
merci

 

[Staple1600]

Bonjour le fil, le forum

Et si tu mets un des mails présents dans Destinaires comme unique destinataire
Exemple : toto@titi.fr en A3
Et dans ton code tu mets
Set .Configuration = iConf
.to ="toto@titi.fr"
.CC =""
.BCC = ""
ou
Set .Configuration = iConf
.to =Range("A3").Text
.CC =""
.BCC = ""

Le mail envoyé va toujours dans les spams ?

 

[gothc]

End With
t = Range("A1:A15")
Destinataires = Join(Application.Transpose(t), ";")
strbody = "Bonjour, Voici le planning . Merci!"
With iMsg

Set .Configuration = iConf
.to = Destinataires
.CC = ""
.BCC = ""
.From = """MR LOUBRY"" <email>"
.Subject = "PLANNING"
.TextBody = strbody
.AddAttachment Fichier
.Send
Kill Fichier
End With
End Sub

Oui avec cette configuration