Macro pour regrouper informations en fonction d'un seul destinataire

Le 05/10/2022 à 16:28

Bonjour,

Suite à mon poste résolu pour "insertion signature mail VBA" et dans cette continuité,

Je souhaite envoyer un mail à chaque destinataire (mail) tout en regroupant les informations qui le concerne. Dans mon exemple ci-dessous, le mail donnerai :

"Bonjour Vincent,

Vous avez les numéro suivants en attente de validation :

SPTQ0001231 - 31/12/2022

SPTQ2000341.. - 31/12/2022 (etc)

Cdlt,"

Puis le macro passerai au destinataire suivant qui aurait peut être qu'un seul numéro contrairement au précédent et ainsi de suite.

Je vous ai joint le fichier Excel pour illustrer mes propos.

capture

Vous avez une idée de comment je pourrai faire svp ? Merci d'avance

16exemple.xlsx (17.51 Ko)
Le 05/10/2022 à 20:15

Bonsoir Mapomi

Voici une possibilité de code, il faut lancer la sub Regrouper

Sub Regrouper()
  Dim dLig As Long, Lig As Long
  Dim sPrenom As String, sNumDate As String
  sPrenom = "": sNumDate = ""
  With ActiveSheet
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 2 To dLig
      sPrenom = .Range("B" & Lig)
      sNumDate = sNumDate & .Range("C" & Lig) & " " & Format(.Range("D" & Lig), "dd/mm/yyyy") & "<br>"
      ' vérifier si suivant identique
      If .Range("A" & Lig) <> .Range("A" & Lig + 1) Then
        Call EnvoiMail(sPrenom, sNumDate)
        sPrenom = "": sNumDate = ""
      End If
    Next Lig
  End With
End Sub

Sub EnvoiMail(sPrenom As String, sNumDate As String)
  ' Déclaration des variables utilisées dans le code
  Dim OutObj As Object, Email As Object
  Dim sBody As String
  ' Création d'une instance Outlook pour envoyer un mail
  Set OutObj = CreateObject("Outlook.Application")
  Set Email = OutObj.CreateItem(0)
  ' Préparer le message
  sBody = "Bonjour " & sPrenom & "<br>" _
  & "Vous avez le/les numéro(s) suivant en attente de validation : <br>" _
  & sNumDate & "<br>" _
  & "Cordialement"
  ' Avec mon objet Email
  With Email
    .Display  ' Afficher le mail pour afficher la signature
    ' Destinataire(s) du mail
    .to = "emaildestinataire@fai.fr"
    ' Copie du mail
    .CC = "emaildestinataire@fai.fr"
    ' Sujet de l'eMail
    .Subject = "Ceci est le sujet de mon mail"
    ' Corps du mail avec signature à la fin
    .HtmlBody = sBody & .HtmlBody
    ' Envoyer l'email
    '.Send
  End With
  ' Effacer les variable objet
  Set Email = Nothing: Set OutObj = Nothing
End Sub

A+

Le 06/10/2022 à 09:50

Bonjour le fil et le forum,

voici une petite modification du code proposé par Bruno, j'ai ajouté une variable sDest pour envoyer à chaque destinataire son propre email

Sub Regrouper()
'https://forum.excel-pratique.com/excel/macro-pour-regrouper-informations-en-fonction-d-un-seul-destinataire-176647

  Dim dLig As Long, Lig As Long
  Dim sPrenom As String, sNumDate As String, sDest As String

  sPrenom = "": sNumDate = ""
  With ActiveSheet
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 2 To dLig
      sPrenom = .Range("B" & Lig)
      sDest = .Range("E" & Lig)
      sNumDate = sNumDate & .Range("C" & Lig) & " " & Format(.Range("D" & Lig), "dd/mm/yyyy") & "<br>"
      ' vérifier si suivant identique
      If .Range("A" & Lig) <> .Range("A" & Lig + 1) Then
        Call EnvoiMail(sPrenom, sNumDate, sDest)
                sPrenom = "": sNumDate = ""
      End If
    Next Lig
  End With
End Sub

Sub EnvoiMail(sPrenom As String, sNumDate As String, sDest As String)
  ' Déclaration des variables utilisées dans le code
  Dim OutObj As Object, Email As Object
  Dim sBody As String

  ' Création d'une instance Outlook pour envoyer un mail
  Set OutObj = CreateObject("Outlook.Application")
  Set Email = OutObj.CreateItem(0)
  ' Préparer le message
  sBody = "Bonjour " & sPrenom & "<br>" _
  & "Vous avez le/les numéro(s) suivant en attente de validation : <br>" _
  & sNumDate & "<br>" _
  & "Cordialement"
  ' Avec mon objet Email
  With Email
    .Display  ' Afficher le mail pour afficher la signature
    ' Destinataire(s) du mail
    .To = sDest '"emaildestinataire@fai.fr"
    ' Copie du mail
    .CC = "emaildestinataire@fai.fr"
    ' Sujet de l'eMail
    .Subject = "Ceci est le sujet de mon mail"
    ' Corps du mail avec signature à la fin
    .HTMLBody = sBody & .HTMLBody
    ' Envoyer l'email
    '.Send
  End With
  ' Effacer les variable objet
  Set Email = Nothing: Set OutObj = Nothing
End Sub

Cordialement

Le 06/10/2022 à 13:01

Bonjour et merci à toi Sequoyah

Parti dans le dév. j'ai fini par zappé cette partie

Au plaisir

Le 17/10/2022 à 20:09

Encore une fois un GRAAND MERCI pour votre retour (et si rapide) !

Désolé du temps de réponse, il fallait que je me pose pour comprendre comment vous avez fait

J'ai encore quelques questions concernant votre code (qui marche tip top), je vous les insère dans le code et je supprime vos commentaires pour que ce soit plus facile à lire pour vous (vous verrez j'ai pas mal de questions...)

Sub Regrouper()

  Dim dLig As Long, Lig As Long
  Dim sPrenom As String, sNumDate As String, sDest As String
  '=> Si c'est un montant qui est une valeur numérique, dois-je utiliser string ou long ?

  sPrenom = "": sNumDate = ""
  '=> que veux dire les "" et : ? Pk on le met pas pour sDest aussi ?

  With ActiveSheet
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    '=> permet de compter le nbre de lignes ?

    For Lig = 2 To dLig
      sPrenom = .Range("B" & Lig)
      sDest = .Range("E" & Lig)
      sNumDate = sNumDate & .Range("C" & Lig) & " " & Format(.Range("D" & Lig), "dd/mm/yyyy") & "<br>"
     'Pk ajouter sNumDate en 2 fois comparément aux autres variables ? 
     'si je souhaite ajouter une nouvelle variable comment je peux faire ? Par exemple sMontant (pour un montant en euros)

      If .Range("A" & Lig) <> .Range("A" & Lig + 1) Then
      '=> pk ajouter un +1 ? Pour dire de comparer avec la ligne en dessous ?
        Call EnvoiMail(sPrenom, sNumDate, sDest)
                sPrenom = "": sNumDate = ""
      End If
    Next Lig
  End With
End Sub

Sub EnvoiMail(sPrenom As String, sNumDate As String, sDest As String)
    '=> pk ajouter sNom, etc ici ? Est-ce une bonne pratique VBA ou il y a vraiment un "grand" interet ?
  Dim OutObj As Object, Email As Object
  Dim sBody As String

  Set OutObj = CreateObject("Outlook.Application")
  Set Email = OutObj.CreateItem(0)

  sBody = "Bonjour " & sPrenom & "<br>" _
  & "Vous avez le/les numéro(s) suivant en attente de validation : <br>" _
  & sNumDate & "<br>" _
  & "Cordialement"

  With Email
    .Display

    .To = sDest

    .CC = "emaildestinataire@fai.fr"

    .Subject = "Ceci est le sujet de mon mail"

    .HTMLBody = sBody & .HTMLBody

  End With
  ' Effacer les variable objet => qu'est ce que cela veut dire exactement effacer les variables obj ?
  ' Est ce que c'est le "End With" qui permet cette manip ?

  Set Email = Nothing: Set OutObj = Nothing
End Sub

'Encore une fois merci x2 :)

Merci beaucoup !

Le 30/01/2023 à 16:03

Bonjour,

Ce dernier message pour remercier chaleureusement Bruno et Sequoyah qui ont pris le temps de m'aider et de me répondre (d'ailleurs j'ai trouvé mes réponses sur mon dernier post )

En effet, grâce à vous, j'ai pu monter en compétence et présenter mes fichiers à ma boss qui est très impressionnée ( )

Merci pour votre bienveillance et votre altruisme Bonne continuation à ce merveilleux forum !

Le 30/01/2023 à 16:11

Bonjour Mapomi et merci de ce retour, ça fait toujours palisir

A+

Rechercher des sujets similaires à "macro regrouper informations fonction seul destinataire"