Envoi de mails avec insertion de cellules

[Barbefeuillue]

Bonsoir à tous,

de nouveau je me tourne vers vous concernant un problème qui commence à me faire perdre non pas la tête... Mais au moins quelques cheveux!

chaque jour j'ai besoin d'envoyer le contenu d'un tableau excel à différents destinataires en fonction du contenu de ce tableau,

j'ai bien réussi à créer une macro pour envoyer chaque ligne à un destinataire mais quand les envois sont nombreux, cela revient parfois à envoyer 15 mails d'affiler à chaque personne.

j'aimerais réussir à incorporer à un message fixe un contenu variable en utilisant pour identifier le contenu le n° de magasin (colonne 4 par exemple - si même magasin alors à mettre dans le même mail),

Ce qui donnerait par exemple :

"Bonjour,

voici ci dessous les factures à traiter rapidement :



Merci par avance,

Cordialement, "


J'ai réussi à bricoler (il n'y à pas d'autre mot...) quelquechose qui permet de faire en semi automatique mais qui est vraiment galère si les données sont nombreuses.

merci beaucoup à ceux qui prendront le temps de m'aider,

 

[Dranreb]

Re : Envoi de mails avec insertion de cellules

Bonjour.

C'est que je ne suis pas spécialiste des envois de couriels.
Sauriez vous compléter cette procédure selon vos besoins ?

Sub Envoyer(ByVal Magasin As Long, ByVal AdrMail As String, ClientEtFact() As Variant)
Rem — Envoi d'un Mail au magasin et adresse Mail spécifiés
Dim L As Long
…
For L = 1 To UBound(ClientEtFact)
   …
   'ClientEtFact(L, 1) représente le numéro client
   'ClientEtFact(L, 2) représente le numéro facture
   …
   Next L
…
End Sub

Si oui je vous écris la procédure qui l'appelle pour chaque destinataire.
Question importante: les lignes de mêmes destinations sont elles toujours ensemble ou faut-il préalablement les regrouper ?

Où si vous préférez (à me le préciser) :

Sub Envoyer(ByVal Magasin As Long, ByVal AdrMail As String, Client() As Long, Factur() As Long)
Rem — Envoi d'un Mail au magasin et adresse Mail spécifiés
Dim L As Long
…
For L = 1 To UBound(Client)
   …
   'Client(L) représente le numéro de client à la Lième ligne
   'Factur(L) représente le numéro de facture à la Lième ligne
   …
   Next L
…
End Sub

 

[Barbefeuillue]

Re : Envoi de mails avec insertion de cellules

Bonjour et merci pour votre réponse,

je vais tenter d'adapter le code et voir si j'y arrive,

oui heureusement les lignes sont regroupées de sorte que les magasins sont listés par ordre croissant,

 

[Dranreb]

Re : Envoi de mails avec insertion de cellules

La procédure appelante pour la 1ère forme serait celle ci :

Sub Distribuer()
Dim Te(), Le As Long, NivRup As Byte, MagCou As Long, LeDéb As Long, _
   AdrCou As String, dL As Long, Ts(), Ls As Long, C As Long
Te = Feuil1.[A2].Resize(Feuil1.[A60000].End(xlUp).Row - 1, 4)
Le = 1: NivRup = 0
Do: 'Début magasin
   MagCou = Te(Le, 3): LeDéb = Le
   Do: ' Début adresse E-Mail
      AdrCou = Te(Le, 4): dL = Le - 1 ' le-(le-1)=1
      Do: 'Détail
         Le = Le + 1: If Le > UBound(Te) Then NivRup = 0: Exit Do
         If Te(Le, 3) <> MagCou Then NivRup = 1: Exit Do
         If Te(Le, 4) <> AdrCou Then NivRup = 2: Exit Do
         Loop
      Rem — Fin adresse E-Mail
      ReDim Ts(1 To Le - LeDéb, 1 To 2)
      For Ls = 1 To UBound(Ts): For C = 1 To 2: Ts(Ls, C) = Te(Le - dL, C): Next C, Ls
      Envoyer MagCou, AdrCou, Ts
      Loop Until NivRup <= 1
   Rem — Fin magasin
   Loop Until NivRup = 0
End Sub

pour celle proposée en édit à la fin, celle ci :

Sub Distribuer()
Dim Te(), Le As Long, NivRup As Byte, MagCou As Long, LeDéb As Long, AdrCou As String, _
   dL As Long, Client() As Long, Factur() As Long, Ls As Long
Te = Feuil1.[A2].Resize(Feuil1.[A60000].End(xlUp).Row - 1, 4)
Le = 1: NivRup = 0
Do: 'Début magasin
   MagCou = Te(Le, 3): LeDéb = Le
   Do: ' Début adresse E-Mail
      AdrCou = Te(Le, 4): dL = Le - 1 ' le-(le-1)=1
      Do: 'Détail
         Le = Le + 1: If Le > UBound(Te) Then NivRup = 0: Exit Do
         If Te(Le, 3) <> MagCou Then NivRup = 1: Exit Do
         If Te(Le, 4) <> AdrCou Then NivRup = 2: Exit Do
         Loop
      Rem — Fin adresse E-Mail
      ReDim Client(1 To Le - LeDéb), Factur(1 To Le - LeDéb)
      For Ls = 1 To UBound(Client): Client(Ls) = Te(Le - dL, 1): Factur(Ls) = Te(Le - dL, 2): Next Ls
      Envoyer MagCou, AdrCou, Client, Factur
      Loop Until NivRup <= 1
   Rem — Fin magasin
   Loop Until NivRup = 0
End Sub

les magasins sont listés par ordre croissant

Au cas où il pouvait y avoir plusieurs contacts différents pour certains magasins, j'espère qu'ils seraient regroupés aussi…

 

[Barbefeuillue]

Re : Envoi de mails avec insertion de cellules

bonsoir Dranreb,

pardon mais je ne comprends pas le code... j'y ai passé un moment en tentant de le décomposer mais je n'y arrive pas,

je n'arrive pas à l'imbriquer à ma procédure pour l'envoi d'un mail.

pourriez vous m'aider (encore...)?

 

[Dranreb]

Re : Envoi de mails avec insertion de cellules

Bonsoir

Il n'a pas lieu de l'imbriquer si vous ne voulez pas vous compliquer les choses.
La procédure Envoyer doit rester indépendante: elle est invoquée par la procédure Distribuer.
Important: vous ne tapez surtout plus du tout dans les cellules : tous ce dont vous avez besoin pour construire votre Mail vous est transmis en paramètres à votre procédure Envoyer. Ou sinon dites moi ce qu'il vous manque.

 

[Barbefeuillue]

Re : Envoi de mails avec insertion de cellules

je ne saisis pas,

la procédure distribuer consiste à paramétrer les lignes à inclure puis la procédure envoyer sert à l'envoi c'est cela?

est ce au niveau des "..." que je dois intégrer mon message?


je suis peut être totalement a côté de la plaque là, je n'ai pas des compétences très poussées et je déduis à peine le fonctionnement de votre code...

 

[Dranreb]

Re : Envoi de mails avec insertion de cellules

la procédure distribuer consiste à paramétrer les lignes à inclure

Enfin elle vous les transmet plus exactement carrément, dans un ou deux tableaux, comme vous préférez, en dernier(s) paramètre(s). Pas le numéro de magasin puisqu'il est pareil pour toutes les lignes, celui là c'est le 1er paramètre : Magasin

est ce au niveau des "..." que je dois intégrer mon message ?

Oui tout à fait. les mise en formes d'en tête, de corps et après c'est le pied.

 

[Barbefeuillue]

Re : Envoi de mails avec insertion de cellules

merci beaucoup je continu de travailler dessus,

 

[Barbefeuillue]

Re : Envoi de mails avec insertion de cellules

décidément je me mélange les pinceaux..!


voici le code que j'essaie de faire fonctionner,

Sub Bouton2_QuandClic(ByVal Magasin As Long, ByVal AdrMail As String, ClientEtFact() As Variant)



Dim Te(), Le As Long, NivRup As Byte, MagCou As Long, LeDéb As Long, _
   AdrCou As String, dL As Long, Ts(), Ls As Long, C As Long
Te = Feuil1.[A2].Resize(Feuil1.[A60000].End(xlUp).Row - 1, 4)
Le = 1: NivRup = 0
Do: 'Début magasin
  MagCou = Te(Le, 3): LeDéb = Le
   Do: ' Début adresse E-Mail
     AdrCou = Te(Le, 4): dL = Le - 1 ' le-(le-1)=1
     Do: 'Détail
        Le = Le + 1: If Le > UBound(Te) Then NivRup = 0: Exit Do
         If Te(Le, 3) <> MagCou Then NivRup = 1: Exit Do
         If Te(Le, 4) <> AdrCou Then NivRup = 2: Exit Do
         Loop
      Rem — Fin adresse E-Mail
      ReDim Ts(1 To Le - LeDéb, 1 To 2)
      For Ls = 1 To UBound(Ts): For C = 1 To 2: Ts(Ls, C) = Te(Le - dL, C): Next C, Ls
      Envoyer MagCou, AdrCou, Ts
      Loop Until NivRup <= 1
   Rem — Fin magasin
   Loop Until NivRup = 0



Rem — Envoi d'un Mail au magasin et adresse Mail spécifiés


Dim L As Long

' If Workbooks("Mail.xls").Sheets("Feuil1").Cells(i, 4).Value <> "" Then


          Dim NomDestinataire
  
  
            Dim strHTML As String
            Dim y As Byte, j As Byte


           Set oOutlook = CreateObject("Outlook.Application")
           Set oNewMail = oOutlook.CreateItem(olMailItem)
    
           NomDestinataire = Workbooks("Mail.xls").Sheets("Feuil2").Cells(i, 4).Value



        For L = 1 To UBound(ClientEtFact)

  
   
                Set iMsg = CreateObject("CDO.Message")
                Set iConf = CreateObject("CDO.Configuration")
 
                strHTML = ""
                strHTML = strHTML & "<HEAD>"
                strHTML = strHTML & "<BODY>"
                strHTML = strHTML & "Bonjour,<BR><BR>"

                strHTML = strHTML & "Voici la liste des écarts constatés sur les factures concernant votre magasin : <BR><BR>"
                strHTML = strHTML & "<TABLE BORDER>"
 
                    For y = 1 To L 'nombre de lignes (exemple plage A1:B5)
 

                        strHTML = strHTML & "<TR halign='middle'nowrap>"
                             For j = 1 To 3 'nombre de colonnes qui est fixe
                                  strHTML = strHTML & "<TD bgcolor='none'align='center'><FONT COLOR='blue'SIZE=3>" _
                                  & Workbooks("Mail.xls").Sheets("Feuil2").Cells(y, j) & "</FONT></TD>"
                             Next j
                        strHTML = strHTML & "</TR>"
                        
                    Next y
 
 
                strHTML = strHTML & "</TABLE>"
 
                strHTML = strHTML & "<BR><BR>Je reste à votre disposition en cas de besoin<BR>"
                strHTML = strHTML & "<BR><BR>Merci de ne pas répondre à cet email, il s'agit d'un traitement automatique<BR>"
                strHTML = strHTML & "<BR>Cordialement,"

                strHTML = strHTML & "</BODY>"
                strHTML = strHTML & ""
    
        With oNewMail
                 
        .Recipients.Add NomDestinataire
        .Subject = "ECARTS FACTURES " & Format(Date, "ddmmyyyy ")
        .HTMLBody = strHTML
      
        .send
        
        End With
  
    Next L


' End If
   


End Sub

Je n'ai pas touché à la première procédure et j'ai intégré (je ne sais si c'est bien fait) le corps du message à la deuxième procédure,

 

[Dranreb]

Re : Envoi de mails avec insertion de cellules

Oui, bon courage.
Mais vu vos difficulté j'ai pris soin de mettre un peu au point mon Distribuer.
Ce n'était pas du luxe car il y avait des bogues…
je me suis servi d'un Envoyer bidon qui fait à peu près la même chose mais dans un MsgBox

Option Explicit

Sub Distribuer()
Dim Te(), Le As Long, NivRup As Byte, MagCou As Long, LeDéb As Long, AdrCou As String, _
   dL As Long, Client() As Long, Factur() As Long, Ls As Long
Te = Feuil1.[A2].Resize(Feuil1.[A60000].End(xlUp).Row - 1, 4).Value
Le = 1: NivRup = 0
Do: 'Début magasin
   MagCou = Te(Le, 3)
   Do: ' Début adresse E-Mail
      AdrCou = Te(Le, 4): LeDéb = Le
      Do: 'Détail
         Le = Le + 1: If Le > UBound(Te) Then NivRup = 0: Exit Do
         If Te(Le, 3) <> MagCou Then NivRup = 1: Exit Do
         If Te(Le, 4) <> AdrCou Then NivRup = 2: Exit Do
         Loop
      Rem — Fin adresse E-Mail
      ReDim Client(1 To Le - LeDéb), Factur(1 To Le - LeDéb)
      dL = 1 - LeDéb
      For Ls = 1 To UBound(Client): Client(Ls) = Te(Ls - dL, 1): Factur(Ls) = Te(Ls - dL, 2): Next Ls
      Envoyer MagCou, AdrCou, Client, Factur
      Loop Until NivRup <= 1
   Rem — Fin magasin
   Loop Until NivRup = 0
End Sub

Sub Envoyer(ByVal Magasin As Long, ByVal AdrMail As String, Client() As Long, Factur() As Long)
Rem — Envoi d'un Mail au magasin et adresse Mail spécifiés
Dim Z As String, L As Long
Z = "Message à envoyer." & vbLf & "Destinataire: " & AdrMail & vbLf & vbLf & "Magasin " & Magasin & vbLf & vbLf & "Client" & vbTab & "Facture"
For L = 1 To UBound(Client)
   Z = Z & vbLf & Client(L) & vbTab & Factur(L)
   Next L
MsgBox Z & vbLf & vbLf & "Bonne reception…", vbInformation, "Essai"
End Sub

Ah je n'avais pas vu votre dernier message. Non, comme vous le voyez il n'y a pas à intégrer quoi que ce soit dans quoi que ce soit d'autre. Les Sub Distribuer et Envoyer sont séparées, et on exécute Distribuer. Envoyer ne s'occupe que de fabriquer le message pour un seul magasin.

 

[Barbefeuillue]

Re : Envoi de mails avec insertion de cellules

il me suffit d'intégrer le code dans un module et d'exécuter la sub "Distribuer" pour faire le test?


encore une fois pardon pour mon manque de connaissances, je suis toujours en train d'utiliser des "boutons" pour exécuter mes macros donc la je suis un peu perdu,

 

[Dranreb]

Re : Envoi de mails avec insertion de cellules

Oui c'est cela. Affectez Distribuer à un bouton. C'est toujours mieux que d'appeler les procédure d'un nom BoutonX_QuandClic qui n'indique absolument pas ce qu'elles font.

 

[Barbefeuillue]

Re : Envoi de mails avec insertion de cellules

Bonjour Dranreb,

merci pour votre code, c'est exactement ce que je recherchais !

volontairement j'ai adapté le code pour coller au mieux avec mes besoins et essayer de le comprendre plutot que de vous demander de me le livrer "clés en main",

j'ai donc ajouté deux colonnes et changé les intitulés, ainsi que le corps du message,


je viens d'adapter la macro pour transformer l'affichage sur MsgBox en envoi de mail et.... ça marche!!

merci beaucoup, je vais tenter d'améliorer encore un peu l'affichage du mail désormais,

 

[Dranreb]

Re : Envoi de mails avec insertion de cellules

dans ma première colonne les valeurs semblent limitées à 9 caractères... il faut pourtant que je puisse en renseigner 11

Le type Long pour cette info ne convient alors pas puisqu'il ne peut supporter que des nombres entiers de valeurs absolues <= 2147483647. Je m'étais basé sur ce que je voyais dans votre 1er fichier. Mais vous parlez de caractères ? Si ça sous entend qu'il peut même contenir des lettres, Double ne conviendrait pas non plus, il faudrait String. Je vais partir de cette derniere hypothèse.

dans les colonnes Mt annoncé Mt reconnu et différence, les valeurs sont arrondies et il faudrait qu'elles soit retranscrites avec leur exact valeur.

La long ne convient pas non plus, Double devrait convenir.

En résumé de ces deux 1ers points, dans les déclarations interne de Distribuer, et les paramètres de Envoyer :

… Compte() As String, Annonce() As Double, Reconnu() As Double

Le décalage est dû au vbTab que j'ai employer pour simuler les alignements dans un tableau. Il se borne à recaler le texte qui suit à la prochaine position multiple de 8. Ça ne se produira pas en langage HTML puisque vous annoncerez les cellules du tableau par des balises entre <>.

je vous suggère par ailleurs une possible amélioration :

… Format(Annonce(L), "#.00") & vbTab & Format(Reconnu(L), "#.00") …