Microsoft 365 Envoi Mail Multi Destinataires

Pat13127 · 9 Juin 2021

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

Lolote83 · 9 Juin 2021

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 &...

Lolote83 · 9 Juin 2021

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 · 9 Juin 2021

Lolote83 à dit:
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,

Lolote83 · 9 Juin 2021

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

Pat13127 · 10 Juin 2021

Merveilleux ! Parfaitement ce que je cherchais !
Je ne sais pas comment te remercier Lolote83 !

Microsoft 365 Envoi Mail Multi Destinataires

Pat13127

XLDnaute Nouveau

Lolote83

Lolote83

XLDnaute Barbatruc

Pat13127

XLDnaute Nouveau

Lolote83

XLDnaute Barbatruc

Pat13127

XLDnaute Nouveau

Discussions similaires