XL 2010 VBA - Envoi mail par sélection de 50 destinataires

[onha]

Bonjour a vous tous,
Je viens de faire le tour de pas mal de forum sur mon problème mais je n'ai pas vraiment trouvé mon bonheur 😕😕
Je souhaiterais via une macro envoyer un mail sans passer par Outlook (j'ai déjà le script).
J'ai dans une feuille "ListeDest" dans la colonne A une liste de plus de 2000 adresses mails.
Est-il possible d'effectuer des envois par paquet de 50 adresses avec une petite tempo entre deux ?
Vous en remerciant par avance pour vos retours
Onha 🙂

 

[zebanx]

Bonjour Onha

Bienvenu sur XLD

Un essai pour vous montrer l'utilisation de :
MOD
APPLICATION.WAIT

Mod renvoie le reste de la division de l’argument nombre par l’argument diviseur.
Le résultat est du même signe que diviseur.
C'est ce qui permet de faire le step.

xl-ment
zebanx

Sub TEMPS()

derligne = Cells(Rows.Count, 1).End(3).Row

For i = 2 To derligne
If i Mod (5) = 0 Then Application.Wait (Now + TimeValue("00:00:02"))
Cells(i, 2) = Cells(i, 1)
Next

End Sub

 

[onha]

Bonjour Onha

Bienvenu sur XLD

Un essai pour vous montrer l'utilisation de :
MOD
APPLICATION.WAIT

Mod renvoie le reste de la division de l’argument nombre par l’argument diviseur.
Le résultat est du même signe que diviseur.
C'est ce qui permet de faire le step.

xl-ment
zebanx

Sub TEMPS()

derligne = Cells(Rows.Count, 1).End(3).Row

For i = 2 To derligne
If i Mod (5) = 0 Then Application.Wait (Now + TimeValue("00:00:02"))
Cells(i, 2) = Cells(i, 1)
Next

End Sub

Bonjour zebanx

Merci pour la bienvenue.
Voilà un bout de code que je pourrais intégrer dans ma macro lorsque j'aurais trouvé la manière d'envoi de mon mail par paquet de 50 adresses mails.
Merci Beaucoup

 

[onha]

Bonjour a tous,

J'avance a petit pas mais j'avance.
En cherchant un peu partout j'ai réussi à écrire ces quelques lignes;
Mon souci c'est je ne peux pas savoir combien d'adresse mail je vais récupérer.
aurait il un moyen de prendre des paquets de 10 destinataires sans être obligé d'effectuer des sélections manuelles

Dim tbl()

With ThisWorkbook.Worksheets("data")
  tbl = .Range("A2:A10").Value 'Sélection Manuelle
  Sheets("Envoi").Range("A1") = Join(Application.Transpose(tbl), ";")
   End With
MsgBox "Envoi du mail au destinataire " & Range("A1")
   Application.Wait (Now + TimeValue("00:00:02"))
 
With ThisWorkbook.Worksheets("data")
  tbl = .Range("A11:A20").Value 'Sélection Manuelle
  Sheets("Envoi").Range("A2") = Join(Application.Transpose(tbl), ";")
End With

MsgBox "Envoi du mail au destinataire " & Range("A2")
   Application.Wait (Now + TimeValue("00:00:02"))
 
With ThisWorkbook.Worksheets("data")
  tbl = .Range("A21:A30").Value 'Sélection Manuelle
  Sheets("Envoi").Range("A3") = Join(Application.Transpose(tbl), ";")
End With
MsgBox "Envoi du mail au destinataire " & Range("A3")
   Application.Wait (Now + TimeValue("00:00:02"))

Je vous joints mon fichier
Merci vos aides précieuses.
Onha

 

[zebanx]

Bonjour Onha

Un essai.
J'étais parti sur l'utilisation de "mod" mais dans le cas de votre boucle, mieux vaut directement utiliser un "step".
A vous de corriger les bornes pour ce step.

xl-ment
zebanx

Sub Concat2()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim Feuil As String
Feuil = "Envoi"
If FeuilExiste(Feuil) Then
    Sheets(Feuil).Select
    Columns("A:A").Select
    Selection.ClearContents
    Range("A1").Select
Else
    With Sheets.Add
     .Name = "Envoi"
    End With
End If

Dim tbl()
 
derligne = ThisWorkbook.Worksheets("data").Cells(Rows.Count, 1).End(3).Row
For i = 2 To derligne - 1 Step 10
 
 With ThisWorkbook.Worksheets("data")
  tbl = .Range("A" & i & ":A" & i + 9).Value
  n = n + 1
  Sheets("Envoi").Range("A" & n) = Join(Application.Transpose(tbl), ";")
 End With
MsgBox "Envoi du mail au destinataire " & Range("A" & n)
   Application.Wait (Now + TimeValue("00:00:02"))
Next i

End Sub

 

[onha]

Bonjour Onha

Un essai.
J'étais parti sur l'utilisation de "mod" mais dans le cas de votre boucle, mieux vaut directement utiliser un "step".
A vous de corriger les bornes pour ce step.

xl-ment
zebanx

Sub Concat2()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim Feuil As String
Feuil = "Envoi"
If FeuilExiste(Feuil) Then
    Sheets(Feuil).Select
    Columns("A:A").Select
    Selection.ClearContents
    Range("A1").Select
Else
    With Sheets.Add
     .Name = "Envoi"
    End With
End If

Dim tbl()

derligne = ThisWorkbook.Worksheets("data").Cells(Rows.Count, 1).End(3).Row
For i = 2 To derligne - 1 Step 10

With ThisWorkbook.Worksheets("data")
  tbl = .Range("A" & i & ":A" & i + 9).Value
  n = n + 1
  Sheets("Envoi").Range("A" & n) = Join(Application.Transpose(tbl), ";")
End With
MsgBox "Envoi du mail au destinataire " & Range("A" & n)
   Application.Wait (Now + TimeValue("00:00:02"))
Next i

End Sub

Bonjour zebanx
C'est exactement cela que je cherchais. Un GRAND GRAND merci 😀😀😀

Une petite question si ma liste s’arrête sur un nombre de 5 destinataires je vais me retrouver a la fin des 5 adresses avec 5 ";"
Est il possible de faire quelque chose ?

Onha

 

[onha]

zebanx
Laisse tomber j'ai rajouté cette ligne

Cells.Replace What:=";;", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

cela fera l'affaire
encore merci

 

[zebanx]

Re-

C'est une très bonne solution.
@+