Sujet Précédent Sujet Suivant

Envoyer des mails à plusieurs destinataires selectionner

netparty Messages postés 5 Date d'inscription jeudi 15 octobre 2020 Statut Membre Dernière intervention 7 août 2022 - Modifié le 6 août 2022 à 15:07
netparty Messages postés 5 Date d'inscription jeudi 15 octobre 2020 Statut Membre Dernière intervention 7 août 2022 - 7 août 2022 à 07:59

Bonjour,

Je cherche le moyen d'envoyer depuis mon formulaire Excel un mail aux destinataires sélectionner dans la listbox (Listbox1).

Dans le formulaire je sélectionne plusieurs destinataires mais je ne sais pas comment faire pour que cela fonctionne.

Private Sub BP_ENVOI_Click()
LI = 0 'réinitialise la variable LI (déclarée publique dans le module [Module1])


  Dim objOL
  Dim objAppt
  Dim lgDerLig As Long
  Dim Ligne As Long
  Const olAppointmentItem = 1
  Const olMeeting = 1
  
  '''lgDerLig = Range("A65536").End(xlUp).Row
  
    myCheck = MsgBox("Ajout d'une pièce jointe aux invitations ?", vbYesNo)
    If myCheck = vbYes Then
'        Do this
       Dim sFichier As Variant
       sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à joindre.")


   ' .Attachments.Add sFichier

    Else
' do that
MsgBox ("Pas de pièce jointe ajoutée.")
    End If
  
  

'''''For Ligne = 3 To lgDerLig
  Set objOL = CreateObject("Outlook.Application")

' entree agenda
  
  Set objAppt = objOL.CreateItem(olMeeting)
  With objAppt
    .Subject = Me.Lbl_PROJET.Caption
    .Start = Me.Lbl_DATE_ECHEANCE.Caption & " " & Me.Txt_HEURE_DEBUT.Value
    .End = Me.Lbl_DATE_ECHEANCE.Caption & " " & Me.Txt_HEURE_FIN.Value
    .Location = "Bureau"
    .Body = Me.Lbl_PROJET.Caption & " " & Me.Lbl_NUMERO.Caption & " " & Me.Lbl_LOT.Caption & " " & Me.Lbl_FOURNISSEUR.Caption & " " & Me.Lbl_OFFRE.Caption           'Message principal
    .BusyStatus = olBusy
    .Categories = ""
    .ReminderSet = True
    .ReminderMinutesBeforeStart = Worksheets("CONFIG").Range("B6")
  



        

    .ReminderOverrideDefault = True
    .ReminderPlaySound = True
    .Importance = olImportanceHigh
    
    If sFichier <> False _
    Then .Attachments.Add sFichier
   
    .MeetingStatus = olMeeting
    
'participant facultatif
    
    '''.OptionalAttendees = ""
    
'participant obligatoire
       
    .RequiredAttendees = "***@***"   ''Cells(Ligne, 2)
    .Send
  End With

  Set objAppt = Nothing
  Set objOL = Nothing
  
  
  
   
'Next Ligne
     
MsgBox "Les invitations ont été envoyées !"

End Sub


Merci d'avance pour votre aide.



Bonne journée à tous

2 réponses

Réponse 1 / 2
cs_Le Pivert Messages postés 7893 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 19 mai 2023 136
Modifié le 6 août 2022 à 16:31

Bonjour,

Un exemple ici

Et là

pour adapter ce code à la ListBox:

Private Sub CommandButton1_Click()
 Dim i As Byte
 Dim dest As String
 'boucle sur les éléments de la listbox
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
        dest = ListBox1.List(i)
        Range("B1") = Range("B1") & dest & ";"
        End If
      Next i
      Range("B1") = Left(Range("B1"), Len(Range("B1")) - 1) 'supprime dernier caractere
End Sub

ensuite à mettre dans le code de l'envoi:

.To = Range("B1")

voilà
1
Réponse 2 / 2
netparty Messages postés 5 Date d'inscription jeudi 15 octobre 2020 Statut Membre Dernière intervention 7 août 2022
7 août 2022 à 07:59

Bonjour @cs_Le Pivert

Merci pour ton aide

Bonne journée
0
Rejoignez-nous