Microsoft 365 Envoi Mail Multi Destinataires

Pat13127

XLDnaute Nouveau
Bonjour à tous,
Cela fait des mois que grâce à vous tous j'avance petit à petit dans mon projet. Il semblait un peu fou au départ, mais commence à ressembler à quelque chose de vraiment très pratique au quotidien ! Donc déjà, merci à tous ceux qui prennent le temps de répondre aux messages, et aux appels au secours.

Aujourd'hui je cale sur un morceau de code. Je ne trouve pas de solution.

Je souhaite envoyer une sélection de cellules de ma feuille POINT_CA à une liste de destinataires. Aujourd'hui, j'utilise les adresses avec des ";" pour les séparer. Mais je voudrais rendre ce script plus autonome et utiliser une liste d'adresses contenues dans B7:B20 dans l'onglet MAGASINS.

Comment demander à mon script d'aller chercher B7:B20 et d'utiliser le contenu comme destinataire du mail, et donc adapter la partie To.=".....

J'espère avoir bien expliqué mon soucis et fourni suffisamment de données pour qu'une âme charitable me vienne en aide !
;)

VB:
Sub Envoi_CA()

If MsgBox("SOUHAITEZ-VOUS ENVOYER LE POINT CA PAR EMAIL ?" & Chr(13) & Chr(10) & "( Une nouvelle fenètre OUTLOOK va être ouverte )", 36, "Envoyer Email") = vbYes Then
    
    Dim OL As Object, myItem As Object, wDoc As Object, Rng As Object
    Dim Fichier As String, plage_mail As Range
    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor
    Set FL = Worksheets("POINT_CA")
    With Sheets("POINT_CA")
    Set plage_mail = .Range("A1:G21")
    End With
    With myItem
        .To = "1@1.fr;2@2.fr;3@3.fr"
        .CC = "pp@aa.aa"
        .Subject = [POINT_CA!C4] & " - Point Chiffres " & Date & ""
        '.HTMLBody = "<HTML><BODY>Bonjour à tous,</p></BODY></HTML>"
        .Display
        plage_mail.Copy
        Set Rng = wDoc.Content
        Rng.InsertParagraphAfter
        Rng.Move 4, 1
        Rng.Paste
        Rng.Move 4
            
        End With
    End If
    Set OL = Nothing: Set myItem = Nothing: Set wDoc = Nothing
    'Remonte à la cellule de Sélection du Magasin
    Range("A1").Activate
    End Sub
 
Solution
Re bonjour,
Voici donc le code complet

VB:
Sub Envoi_CA()

If MsgBox("SOUHAITEZ-VOUS ENVOYER LE POINT CA PAR EMAIL ?" & Chr(13) & Chr(10) & "( Une nouvelle fenètre OUTLOOK va être ouverte )", 36, "Envoyer Email") = vbYes Then
   
    Dim OL As Object, myItem As Object, wDoc As Object, Rng As Object
    Dim Fichier As String, plage_mail As Range
    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor
    Set FL = Worksheets("POINT_CA")
    With Sheets("POINT_CA")
    Set plage_mail = .Range("A1:G21")
    End With
     
   
    With myItem
        .To = ListeTo
       
        .CC = "pp@aa.aa"
        .Subject = [POINT_CA!C4] & " - Point Chiffres " &...

Lolote83

XLDnaute Accro
Bonjour,
Avec ce code tu devrais t'en sortir
VB:
Sub ListeTo()
    For Each xCell In Range("B7:B20")
        xCpt = xCpt + 1
        If xCpt = 1 Then
            xTo = xCell
        Else
            xTo = xTo & ";" & xCell
        End If
    Next xCell
End Sub
@+ Lolote
 

Pat13127

XLDnaute Nouveau
Bonjour,
Avec ce code tu devrais t'en sortir
VB:
Sub ListeTo()
    For Each xCell In Range("B7:B20")
        xCpt = xCpt + 1
        If xCpt = 1 Then
            xTo = xCell
        Else
            xTo = xTo & ";" & xCell
        End If
    Next xCell
End Sub
@+ Lolote
Bonjour,
Merci beaucoup pour ra réponse Lolote !

Ma liste d'adresses email est contenue dans une autre feuille nommée "MAGASINS", comme je le précisais. Comment puis-je adapter la référence que tu me donnes "For Each xCell In Range("B7:B20") ? Ce code est-il à mettre dans un module ou dans ThisWorkbook ?

Et puis je ne vois pas comment appeler cette macro dans mon script.... 😩

Merci pour tes précisions,
 
Dernière édition:

Lolote83

XLDnaute Accro
Re bonjour,
Voici donc le code complet

VB:
Sub Envoi_CA()

If MsgBox("SOUHAITEZ-VOUS ENVOYER LE POINT CA PAR EMAIL ?" & Chr(13) & Chr(10) & "( Une nouvelle fenètre OUTLOOK va être ouverte )", 36, "Envoyer Email") = vbYes Then
   
    Dim OL As Object, myItem As Object, wDoc As Object, Rng As Object
    Dim Fichier As String, plage_mail As Range
    Set OL = CreateObject("Outlook.Application")
    Set myItem = OL.CreateItem(olMailItem)
    Set wDoc = myItem.GetInspector.WordEditor
    Set FL = Worksheets("POINT_CA")
    With Sheets("POINT_CA")
    Set plage_mail = .Range("A1:G21")
    End With
     
   
    With myItem
        .To = ListeTo
       
        .CC = "pp@aa.aa"
        .Subject = [POINT_CA!C4] & " - Point Chiffres " & Date & ""
        '.HTMLBody = "<HTML><BODY>Bonjour à tous,</p></BODY></HTML>"
        .Display
        plage_mail.Copy
        Set Rng = wDoc.Content
        Rng.InsertParagraphAfter
        Rng.Move 4, 1
        Rng.Paste
        Rng.Move 4
           
        End With
    End If
    Set OL = Nothing: Set myItem = Nothing: Set wDoc = Nothing
    'Remonte à la cellule de Sélection du Magasin
    Range("A1").Activate
End Sub

Function ListeTo()
    xCpt=0
    With Sheets("MAGASINS")
        For Each xCell In .Range("B7:B20")
            xCpt = xCpt + 1
            If xCpt = 1 Then
                xTo = xCell
            Else
                xTo = xTo & ";" & xCell
            End If
        Next xCell
    End With
    ListeTo = xTo
End Function
@+ Lolote83
 

Discussions similaires

Statistiques des forums

Discussions
288 632
Messages
1 893 633
Membres
169 984
dernier inscrit
mdemrs
Haut Bas