Envoyer un fichier par email

Bonjour j'ai une macro qui fonctionne très bien mais je cherche a pouvoir envoyer le fichier a plusieurs personnes et pouvoir choisir a qui a l'aide d'un paramétrage pour 20 adresses email

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("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") = "email1@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

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

With iMsg
Set .Configuration = iConf
.to = "email 1@gmail.com"
.CC = "email 2@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 = """Mr paul"" <email@gmail.com>"

.Subject = "planning"
.TextBody = strbody

.AddAttachment Fichier
.Send

Kill Fichier

End With
End Sub

Bonsoir,

Si cela peut -aidé un post similaire

ici vba-envoyer-un-mail-a-plusieurs-destinataires par Waard merci à lui

crdlt,

André