XL 2013 envoi mail va excel : faire une boucle avec 10 destinataires à chaque envoi

[david54520]

Bonjour à tous.
Merci d'avance à celles et ceux qui s'intéresseront au pb que je rencontre.
Je vous passe le pourquoi du comment, mais j'ai besoin de créer une macro pour envoi de mail, par paquets de 10

Pour la création de cette macro, tout fonctionne comme désiré sauf un truc : il faut que je puisse envoyer mes mails par "paquets de 10 adresses" donc
J'ai une liste importante au début (liste initiale), via la macro PAQUET10, je copie colle les 10 premières adresses de ma liste initiale que je colle dans l'onglet à envoyer.
Je supprime ensuite les 10 premières adresses de la liste initiale, celle qui était la onzième adresse devient donc la première, et ainsi de suite
Puis, la macro est censée tourner avec une boucle : tant que la liste initiale n'est pas vide (onglet "intermédiaire"), tu fais les mails...

J'ai fait des essais avec une liste de 30 adresses
il me fait bien 3 mails, le premier ayant les 10 premières adresses, et puis çà part en cacahouète : le second les 10 adresses précédentes puis les 10 suivantes, et le troisième les 20 adresses précédentes et les 10 suivantes

J'ai l'impression que j'ai un problème dans ma boucle...ou qu'il faudrait que je vide la mémoire de ma variable "destinataires" avec de refaire un tour....mais là...je bloque
ci dessous la macro en question

Sub envoiPARmail_col()

Do While Sheets("intermediaire").Range("A1") <> ""

Call PAQUET10

Dim oOutlook As Object
Set oOutlook = CreateObject("Outlook.Application")

Dim oMail As Object
Set oMail = oOutlook.CreateItem(0)

With oMail
Dim sujet As String
Dim nomfic As String
Dim piecejointe As String


sujet = Sheets("mailg").Range("g3").Value
piecejointe = ActiveWorkbook.Path & "\" & Sheets("mailg").Range("g8").Value & ".pdf"
nomfic = Dir(piecejointe)


Dim k As Integer
Dim Destinataires As String

For k = 1 To Sheets("a_envoyer").Range("A65536").End(xlUp).Row
Destinataires = Destinataires & Sheets("A_envoyer").Range("A" & k) & ";"

Next k

Sheets("mailg").Range("A1:a16").Select


.SentOnBehalfOfName = "ladressequejeveux@truc.fr"
.display

.attachments.Add piecejointe
.Subject = sujet
'.To = ************
.BCC = Destinataires


Dim oObjetWord As Object
Set oObjetWord = .GetInspector.WordEditor
Selection.Copy
oObjetWord.Range(0).Paste

End With
Loop

MsgBox "Traitement terminé"
End Sub


Au plaisir de vous lire ! David

 

[Compte Supprimé 979]

Bonjour David54520

Essayez comme ceci

Sub envoiPARmail_col()
  Dim oOutlook As Object, oMail As Object
  Dim Sujet As String, NomFic As String
  Dim PieceJointe As String, Destinataires As String
  Dim ShtE As Worksheet
  Dim oObjetWord As Object
  Dim Lig As Long, dLig As Long, lDest As Long
  ' Definir la feuille contenant les emails
  Set ShtE = Sheets("a_envoyer")
  ' Dernière ligne de cette feuille
  dLig = ShtE.Range("A" & Rows.Count).End(xlUp).Row
  ' Pour toutes les lignes par pas de 10
  For Lig = 1 To dLig Step 10
    ' Créer une instance d'Outlook et de mail
    Set oOutlook = CreateObject("Outlook.Application")
    Set oMail = oOutlook.CreateItem(0)
    '
    With oMail
      .Display
      .SentOnBehalfOfName = "ladressequejeveux@truc.fr"
      Sujet = Sheets("mailg").Range("g3").Value
      PieceJointe = ActiveWorkbook.Path & "\" & Sheets("mailg").Range("g8").Value & ".pdf"
      NomFic = Dir(PieceJointe)
      ' Effacer la liste des destinataires si existe
      Destinataires = ""
      ' Récupérer les 10 destinataires
      For lDest = 0 To 9
        Destinataires = Destinataires & ShtE.Cells(Lig + lDest, 1) & ";"
      Next lDest
      '.To = ************
      .BCC = Destinataires
      .attachments.Add PieceJointe
      .Subject = Sujet
      Set oObjetWord = .GetInspector.WordEditor
      Sheets("mailg").Range("A1:a16").Copy
      oObjetWord.Range(0).Paste
    End With
    Set oMail = Nothing: Set oOutlook = Nothing
  Next Lig
  MsgBox "Traitement terminé"
End Sub

A+

 

[david54520]

Bonjour BrunoM45
Les premiers essais sont quasi parfaits !!

Merci beaucoup!
Et donc si j'ai bien compris :
Set oMail = Nothing: Set oOutlook = Nothing

permet d'effacer de la mémoire le mail précédent.
Mais bien sûr !!
et donc de ne plus retrouver les destinataires précédents

Trop fort Bruno !

il me faut peaufiner :
.SentOnBehalfOfName =
étrangement il ne prend plus l'adresse d'expéditeur que je veux

Si j'ai toujours bien compris également, je pourrais me passer de la boucle intermédiaire qui était censée me créer dans une page, une série de 10 adresses.

Je vais prendre le temps de regarder et tester à nouveau, mais d'ores et déjà je renouvelle mes remerciements pour la rapidité et la justesse de la réponse !

A bientôt, David

 

[david54520]

Rebonjour Bruno m45
Je me suis très largement inspiré de votre production pour réaliser ma tâche.
Et je rencontre un nouveau souci : quand je modifie .display en .send...le système me dit qu il lui faut un destinataire.

J ai tenté avec un destinataire unique (en retirant la boucle) via une adresse mail mise dans une cellule.

Et donc destinataires =sheets ("lafeuilledouhaitee"). Range ("la cellulecible").value
Mais.... Ça veut pas.
A votre avis sur est ce qui pourrait expliquer ce petit pataquès.
Merci d avance. David

 

[Compte Supprimé 979]

Bonsoir David54520

Il ne faut pas modifier ".Display" au début de la procédure par un ".Send"
Le ".Display" au début est pour afficher le mail avec sa signature

Sinon pour 1 seul destinataire autant utiliser ".To"

Sub envoiPARmail_col()
  Dim oOutlook As Object, oMail As Object
  Dim Sujet As String, NomFic As String
  Dim PieceJointe As String, Destinataires As String
  Dim ShtE As Worksheet
  Dim oObjetWord As Object
  Dim Lig As Long, dLig As Long, lDest As Long
  ' Definir la feuille contenant les emails
  Set ShtE = Sheets("a_envoyer")
  ' Dernière ligne de cette feuille
  dLig = ShtE.Range("A" & Rows.Count).End(xlUp).Row
  ' Pour toutes les lignes par pas de 10
  For Lig = 1 To dLig Step 10
    ' Créer une instance d'Outlook et de mail
    Set oOutlook = CreateObject("Outlook.Application")
    Set oMail = oOutlook.CreateItem(0)
    '
    With oMail
      .Display
      .SentOnBehalfOfName = "ladressequejeveux@truc.fr"
      Sujet = Sheets("mailg").Range("g3").Value
      PieceJointe = ActiveWorkbook.Path & "\" & Sheets("mailg").Range("g8").Value & ".pdf"
      NomFic = Dir(PieceJointe)
      ' *** ICI le destinataire
      .To = Sheets ("lafeuilledouhaitee"). Range ("lacellulecible").Value
     ' ***
      .attachments.Add PieceJointe
      .Subject = Sujet
      Set oObjetWord = .GetInspector.WordEditor
      Sheets("mailg").Range("A1:a16").Copy
      oObjetWord.Range(0).Paste
      .Send  ' Envoi directe
    End With
    Set oMail = Nothing: Set oOutlook = Nothing
  Next Lig
  MsgBox "Traitement terminé"
End Sub

A+

 

[david54520]

bonsoir,

Merci pour le retour toujours rapide et efficace.

Du coup, j'ai donc laissé le .display, qui fonctionne parfaitement à cet endroit et j'ai rajouté un .send avant le end With, ce qui assure l'envoi automatique, sans "l'aperçu avant envoi".
Et ca marche , y compris avec le destinataire en .BCC

merci pour l'échange et peut-être à une autre fois.

Bien cordialement, David