Sélection multiple dans une ListBox et envoyer courriel à tous

Bonjour à tout le Forum!

J'ai une ListBox1 contenant une base de donnés se retrouvant dans une feuille qui sont des contacts donc il y a une colonne Nom d'entreprise, Responsable, Téléphone et Courriel.

Ce que j'aimerais c'est quand sélectionnant plusieurs contact dans la ListBox1 que je puisse à l'aide d'une CommandButton pouvoir récupérer l'adresse courriel de chacun et envoyer un courriel à tous. Actuellement je suis capable de le faire pour un! Voici mon code :

Private Sub CommandButton_Courriel_Click()Set f = Sheets("REGISTRE DES SOUS-TRAITANTS")'Dim X As Integer'If ListBox1.Selected(X) = True ThenDim mail As Integer'f.Visible = Truef.Selectmail = UF_Contact.TextBox_Index + 1Dim ObjOutlook As ObjectDim ObjMessage As ObjectSet ObjOutlook = CreateObject("Outlook.Application")Set ObjMessage = ObjOutlook.createitem(0)ObjMessage.DisplayWith ObjMessage.To = Cells(mail, 6).Value.Subject = " | "End WithSet ObjOutlook = NothingEnd IfEnd Sub

Est-ce que vous pouvez m'aider? :)

Bonjour CedL, bonjour le forum,

Code à adapter et à attribuer à un CommdnButton (ici CommandButton1) :

Private Sub CommandButton1_Click()
dim AM as string 

With Me.ListBox1
    For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
            AM = .Column(5, 1)
            'ton code ici pour envoyer le mail avec AM comme variable pour l'adresse mail
        End If
    Next I
End With
End Sub

Bonjour ThauThème,

Merci pour ton aide, c'est très apprécié!

J'ai essayé le code et il fonctionne en parti, la sélection multiple semble être comprise exemple si je sélectionne 4 contacts il ouvre 4 fenêtres différente, mais avec la même adresse courriel qui est celui de la 2e sélection... Il faudrait en fait que dans 1 courriels les 4 adresses courriel si retrouve dans envoie. Voici le code avec mon code intégré au tien :

Dim AM As String

With UF_Contact.ListBox1
    For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
            AM = .Column(5, 1)

Dim ObjOutlook As Object
Dim ObjMessage As Object

Set ObjOutlook = CreateObject("Outlook.Application")
Set ObjMessage = ObjOutlook.createitem(0)

ObjMessage.Display

With ObjMessage
.To = AM
.Subject = " | "

End With

Set ObjOutlook = Nothing

        End If
    Next I
End With

AM = .Column(5, 1)

Pour

AM = .Column(5, 0)

Il va prendre la 1ère adresse courriel de la sélection au lieu de la 2e, il ouvre toujours 4 fenêtres différente et uniquement avec une adresse courriel.

Re,

J'ai toujours galéré pour envoyé un email par VBA et ne ne connais pas bien la manière. Mais logiquement, le code ci-dessous devrait soit fonctionner, soit te permettre de le faire fonctionner en le modifiant.

Le principe est de stocker les adresses mail dans un tableau AM. Avec Join, on obtient la liste L des éléments du tableau séparés par une virgule...

Sub Macro5()
Dim AM() As Variant
Dim K As Integer
Dim L As String
Dim ObjOutlook As Object
Dim ObjMessage As Object

With UF_Contact.ListBox1
    For I = 0 To .ListCount - 1
        If .Selected(I) = True Then
            K = K + 1
            ReDim Preserve AM(1 To K)
            AM(K) = .Column(5, 1)
        End If
    Next I
End With
L = joint(Application.Transpose(AM), ",") 'peut-être remplacer la virgule par un point-virgule
Set ObjOutlook = CreateObject("Outlook.Application")
Set ObjMessage = ObjOutlook.createitem(0)
With ObjMessage
    .to = L
    .Subject = " | "
End With
Set ObjOutlook = Nothing
End Sub

Re,

Aucun problème ça m'aide déjà beaucoup!

À la ligne :

L = Join(Application.Transpose(AM), ";")

Je comprends ce que tu veux faire ça devrait fonctionner et tu as raisons pour faire la séparation par un point virgule. En lançant le code il a fait une erreur d'argument à cette ligne. J'ai tenter de la réécrire autrement, mais ça n'a pas plus fonctionné.

Re,

Ouais c'est Join et pas Joint ! Quel *** ! Pourtant il a belle lurette que je les fume plus...

Bon, essai avec :

L = Join(AM, ",") 

ou

L = Join(AM, ";") 

Mes test me renvoient bien une liste L...

Ouin j'avais essayé et ça ne faisait plus de code d'erreur sauf que plus rien ne se passait, j'avais beau cliquer sur le Commandbutton et rien ne se passait...

Re,

Après, c'est le code pour les mails qu'il faut peut-être revoir. Mais là... Comme je t'ai dit au début, je sèche.

Chez moi non plus il ne se passe rien avec ce code même si L n'est pas vide...

Oui je crois aussi que rendu là c'est le codage pour les mails puisque la fonction L marche très bien effectivement! Je vais me pencher sur le code mail je te reviens si je trouve quelque chose!

Merci encore pour ton aide ça beaucoup aider à avancer!

Re,

Je viens de trouver le problème du pourquoi l'application Outlook ne démarrait il manquait uniquement la ligne de code :

ObjMessage.Display

Toute fois la sélection multiple des courriels à partir de la sélection multiple de la ListBox1 ne se fait pas correctement, il refait la même chose soit si je sélectionne 4 contacts il prendre l'adresse courriel du 2e et le recopie 4 fois.