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

onha

XLDnaute Nouveau
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 :confused::confused:
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

XLDnaute Accro
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

VB:
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
 

Pièces jointes

  • step 5.xlsm
    17.4 KB · Affichages: 5

onha

XLDnaute Nouveau
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

VB:
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

XLDnaute Nouveau
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
VB:
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
 

Pièces jointes

  • EnvoiMail.xlsm
    19.4 KB · Affichages: 5

zebanx

XLDnaute Accro
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

VB:
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
 

Pièces jointes

  • envoi_mail.xlsm
    18.8 KB · Affichages: 4

onha

XLDnaute Nouveau
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

VB:
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 :D:D:D

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
 
Dernière édition:

onha

XLDnaute Nouveau
zebanx
Laisse tomber j'ai rajouté cette ligne

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

cela fera l'affaire
encore merci
 

Discussions similaires