dindin
XLDnaute Occasionnel
Bonjour le Forum,
j'utilise un code VBA pour envoyer plusieurs mail à des clients (120) avec :
- mail nominatif à chaque destinataire
- joindre une facture nominative à chacun et un courrier (le même) à tout le monde.
tout fonctionne très bien sauf la boucle qui va joindre la facture nominative de chacun. Il y a un blocage je ne sais pas ou.
en fait la boucle joint la facture du 1 er client à tout le monde, ce qui n'est pas de tout l'objectif.
pour des raisons de confidentialité, je ne pourrai pas joindre le fichier, mais voici le code en question:
le blocage est dans cette boucle
j'aurai besoin de votre aide SVP pour remédier à ce souci
Merci d'avance
j'utilise un code VBA pour envoyer plusieurs mail à des clients (120) avec :
- mail nominatif à chaque destinataire
- joindre une facture nominative à chacun et un courrier (le même) à tout le monde.
tout fonctionne très bien sauf la boucle qui va joindre la facture nominative de chacun. Il y a un blocage je ne sais pas ou.
en fait la boucle joint la facture du 1 er client à tout le monde, ce qui n'est pas de tout l'objectif.
pour des raisons de confidentialité, je ne pourrai pas joindre le fichier, mais voici le code en question:
VB:
Sub envoi_mails()
'envoi mail
ActiveWorkbook.Save
'Feuil16.Range("I2").Value = Destinataire.Value
Dim ListeDest()
Dim ListeComment()
Dim i As Long
Dim oMsgApp As Object
Dim oMsg As Object
Dim sListeDest As String
Dim sFichier As String
'déclarer les variable
Dim a As Variant, name As String
'Dim li As String
name = ActiveWorkbook.name
ChDir ThisWorkbook.Path ' & "\" & "Formulaire_Dm"
'si fichier selectionné ouvrir en arrière plan outlook
Set oMsgApp = CreateObject("Outlook.Application")
ListeDest() = Range("Tableau2[Mail]")
ListeComment() = Range("Tableau2[Commentaire]")
'sFichier = Range("Tableau2[joint]")
li = Sheets("Base destinataire_formulaire").Cells(3600, 1).End(xlUp).Row ' a partir de la ligne 36000 TROUVE LA 1ER CELLULE VIDE EN REMONTANT DANS LA COLONNE 1 (a)
For i = 2 To li
sFichier = Sheets("Base destinataire_formulaire").Cells(i, 6).Value
Next
For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
Set oMsg = oMsgApp.CreateItem(0)
With oMsg
.To = ListeDest(i, 1)
.Attachments.Add sFichier 'fichier en pc jointe
.Subject = "Votre Formulaire de rénouvellement" ' : " & ActiveSheet.Range("B15").Value & " _ " & ActiveSheet.Range("E9").Value & " _ " & ActiveSheet.Range("I27").Value 'objet du mail
.Body = "Bonjour" & Chr(10) & Chr(13) & _
ListeComment(i, 1) & Chr(10) & Chr(13) & "Restant à votre disposition"
.Send
End With
Set oMsg = Nothing
Next
oMsgApp.Quit
Set oMsgApp = Nothing
MsgBox " Mails envoyés avec succés "
End Suble blocage est dans cette boucle
Code:
li = Sheets("Base destinataire_formulaire").Cells(3600, 1).End(xlUp).Row ' a partir de la ligne 36000 TROUVE LA 1ER CELLULE VIDE EN REMONTANT DANS LA COLONNE 1 (a)
For i = 2 To li
sFichier = Sheets("Base destinataire_formulaire").Cells(i, 6).Valuej'aurai besoin de votre aide SVP pour remédier à ce souci
Merci d'avance
