Microsoft 365 Envoi Mail Multi Destinataires

P

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
L
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 &...
Trier par date Trier par votes
P

Pat13127

XLDnaute Nouveau
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
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
L

Lolote83

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Solution

Discussions similaires

N
  • Question
Microsoft 365 Envoi via Excel avec OutlookNew
Réponses
4
Affichages
351
Titou37P
Titou37P
G
  • Question
Microsoft 365 Vba Excel l'instruction Set OutApp = CreateObject("Outlook.Application") bloque excel
Réponses
2
Affichages
175
laurent950
laurent950
N
  • Question
Microsoft 365 Code VBA
Réponses
7
Affichages
559
TooFatBoy
TooFatBoy
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
273
Phil69970
Phil69970
S
  • Résolu(e)
Microsoft 365 Envoi de la signature de l'utilisateur macro envoi de mail
Réponses
3
Affichages
173
spike29
S
halecs93
  • Question
Microsoft 365 Générer mail via Excel
Réponses
2
Affichages
623
halecs93
halecs93
Chaton0408
  • Question
Microsoft 365 VBA Création Question liste destinataire
Réponses
6
Affichages
382
youky(BJ)
youky(BJ)
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
789
job75
job75
J
  • Question
XL 2016 envoie mail automatique lors de double-clic sur cellule
Réponses
6
Affichages
550
J@ba
J
A
  • Résolu(e)
XL 2021 Macro de création mail de relance avec référence cellules
Réponses
4
Affichages
548
arnoldbrice19
A

Membres actuellement en ligne

5 membres et 90 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 783
Messages
2 112 922
Membres
111 702
dernier inscrit
ELEHMAEA