Synthèse d'un tableau conditionnée + email

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion jozerebel
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
J

jozerebel

XLDnaute Occasionnel
Bonjour à tous,

J'ai un fichier excel où j'archive pas mal de données.

Chaque mois, je fais une synthèse en fonction de secteurs que j'envoie à mes collègues.

Ainsi, le collègue A reçoit une synthèse du secteur A, le collègue B une synthèse du secteur B...

Ma synthèse ne comprend pas toutes les colonnes (j'aimerais donc que la macro sélectionne des colonnes spécifiques à déterminer) et est ensuite envoyée par mail.

J'aimerais que tout se fasse automatiquement : envoi d'une liste synthètique par mail (sachant que la liste doit être reprise dans le corps du mail et pas dans un fichier joint).

Je joins un fichier au cas où...

D'avance merci pour votre aide!
 

Pièces jointes

Trier par date Trier par votes
Re : Synthèse d'un tableau conditionnée + email

Salut jozerebel,
personnellement, je ferais comme ceci :

VB: 
Option Explicit

Sub hypertext_email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim i As Byte

For i = 2 To 8
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    'C'est ici que tu mets le texte. J'ai mis le contenu des
    'colonne A et B en exemple
    strbody = Range("A" & i).Value & "-" & Range("B" & i).Value
    
    On Error Resume Next
    With OutMail
        .To = Range("H" & i).Value
        .CC = ""
        .BCC = ""
        .Subject = "Lien hypertexte"
        .Body = strbody
        '.Display  'Si tu veux afficher le message avant de l'envoyer. Selon moi, dans ton cas, c'est inutile de le prévisionner.
        .Send
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
Next i

End Sub

Le code est inspiré de ce qu'avait déjà fourni l'ami Staple ici :
https://www.excel-downloads.com/threads/excel-vba-et-outlook.82762/

Bonne continuité,

Étienne
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Synthèse d'un tableau conditionnée + email

Salut Jo,
j'ai fait une petite modification dans le code, j'avais laissé mon adresse perso pour les tests ! 😉 Un peu endormi le bonhomme !!!

Quand tu dis conditionner l'envoi, à quoi tu fais allusion ?

À titre informatif, j'ai reçu 8 mails de toi 😉

À te relire !

Étienne
 
Vote positif 0 Vote négatif
Re : Synthèse d'un tableau conditionnée + email

Salut Jo,
c'était un peu plus de sport.

Voici un essai. Dis-moi ce que tu en penses !

VB: 
Option Explicit

Sub Test()

Dim Dico As Object, OutApp As Object, OutMail As Object
Dim ValeurRecherche, RangePlage, x, c
Dim firstAddress As String
Dim DL As Long
Dim strbody As String

'*****************************************************************************************************************
'1re étape : On va faire une liste sans doublon des personnes qui sont sur ta liste d'envoi
'*****************************************************************************************************************
Set Dico = CreateObject("Scripting.Dictionary")
DL = Cells(65536, 1).End(xlUp).Row
RangePlage = Range(Cells(2, 1), Cells(DL, 1)).Address
For Each ValeurRecherche In Sheets(ActiveSheet.Name).Range(RangePlage)
    If Not Dico.Exists(ValeurRecherche.Value) And ValeurRecherche.Value <> "" Then
        Dico.Add ValeurRecherche.Value, ValeurRecherche.Value
    End If
Next ValeurRecherche


'*****************************************************************************************************************
'2e étape : Pour chacune de ces personnes, on va aller chercher toute l'information qui lui est destiné et on
        '   va la mettre dans le corps du message.
'*****************************************************************************************************************
For Each x In Dico.Keys() 'Pour chacune des personnes qui se trouve dans notre liste sans doublon
    strbody = ""
    Set c = Range(Cells(1, 1), Cells(DL, 1)).Find(Dico(x), LookIn:=xlValues, lookat:=xlWhole) 'On va aller faire une recherche pour trouver la personne
    If Not c Is Nothing Then 'Si on la trouve, alors ...
    firstAddress = c.Address
    'On va faire une loop pour voir toutes les fois que son nom revient et on va conserver toute l'info dans le corps du texte pour le email
        Do
          strbody = strbody & Range("B" & c.Row).Value & "-" & Range("C" & c.Row).Value & "-" & Range("D" & c.Row).Value & "-" & Range("E" & c.Row).Value & Chr(13)
          Set c = Range(Cells(1, 1), Cells(DL, 1)).FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    
    'Ensuite on crée le email et on l'envoie
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    
    On Error Resume Next
    With OutMail
        .To = Range("H" & c.Row).Value
        .CC = ""
        .BCC = ""
        .Subject = "Lien hypertexte"
        .Body = strbody
        '.Display  'Si tu veux afficher le message avant de l'envoyer. Selon moi, dans ton cas, c'est inutile de le prévisionner.
        .Send
    End With
    On Error GoTo 0
    
    Set OutMail = Nothing
    Set OutApp = Nothing
Next

Set Dico = Nothing

End Sub

À te relire,

Étienne
 
Dernière édition:
Vote positif 0 Vote négatif
Re : Synthèse d'un tableau conditionnée + email

Re,

J'ai encore une petite demande...

L'envoi des informations est également conditionné à la valeur qu'il y a dans une colonne (disons G). Quand cette colonne est vide, la ligne doit être envoyée. Quand elle est remplie, la ligne ne doit pas être envoyée...

J'espère avoir été clair dans mes explications...

Est-ce possible?

D'avance merci pour ton aide.
 
Vote positif 0 Vote négatif
Re : Synthèse d'un tableau conditionnée + email

Salut jo,
pour réaliser ta dernière demande, tu n'as qu'à remplacer la ligne suivante :
Code: 
strbody = strbody & Range("B" & c.Row).Value & "-" & Range("C" & c.Row).Value & "-" & Range("D" & c.Row).Value & "-" & Range("E" & c.Row).Value & Chr(13)
par ceci
Code: 
If Cells(c.Row, 7).Value = "" Then strbody = strbody & Range("B" & c.Row).Value & "-" & Range("C" & c.Row).Value & "-" & Range("D" & c.Row).Value & "-" & Range("E" & c.Row).Value & Chr(13)

Cordialement,

Étienne
 
Vote positif 0 Vote négatif
Re : Synthèse d'un tableau conditionnée + email

Bonjour Etienne, Bonjour le fofo,

la macro marche bien mais lorsque Outlook s'ouvre, un message apparaît "un programme tente d'envoyer un message..." et je dois attendre pour ensuite cliquer sur 'oui" ... ce qui n'est pas très pratique étant donné que l'objetif initial était d'automsatiser le plus possible la chose...

j'ai lu sur le net qu'il existait un programme "say yes" mais je ne peux l'utiliser dans mon entreprise.

En outre, il faut obligatoirement que je passe pas Outlook et pas un autre logiciel de messagerie.

N'y a t-il pas moyen d'outrepasser ce message par macro?

Merci à tous!
 
Vote positif 0 Vote négatif
Re : Synthèse d'un tableau conditionnée + email

Bonjour,

Oui il existe un moyen de contourner le probleme : regarde la fonction ci dessous :
Je sais pas si elle marche telle quelle car je l ai simplifié à la va vite.

Code: 
Sub EnvoyerMail(ByVal AdresseMail As String, ByVal Copie As String, ByVal ObjetMail As String, ByVal CorpsMail As String, ByVal AttachMail As String)
'il vaut mieux avoir ouvrir outlook au préalable
'Dans la barre de tache : outil/reference selectionner :Microsoft Outlook 11.0 library
'envoi de mail automatique
'initialisation des objets
  ' create new Outlook MailItem
  Set objApp = CreateObject("Outlook.Application")
  Set l_Msg = objApp.CreateItem(olMailItem)
'construction du mail
With l_Msg
    .To = AdresseMail
    .BCC = Copie '.BCC si on veut pas que sur le mail soit affiché les copies ou CC si on veut pas cacher
    .Subject = ObjetMail
    If AttachMail <> "" Then
        .Attachments.Add "TOTO.xls"
    End If
    .HTMLBody = CorpsMail
    .Display
End With
'attente de 3 secondes le temps que tous les pcs aient le tps de réagir
Attendre (3)
'simulation d'appui des touches du clavier
SendKeys "%v", True
End Sub
Sub Attendre(Secondes As Integer)
' Cette procédure temporise pendant le nombre
' de secondes qu'on lui transmet en argument
Dim Début As Long, Fin As Long, Chrono As Long
Début = Timer
Fin = Début + Secondes
Do Until Timer >= Fin
    DoEvents
Loop
End Sub

Cordialement


Suistrop
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

6
  • Question Question
XL 2019 Générer mails sous conditions
2
Réponses
26
Affichages
2 K
Oneida
Oneida
M
  • Question Question
XL 2016 Envoi d'un mail : destinataires selon valeur d'une colonne
Réponses
13
Affichages
3 K
fanch55
fanch55
O
  • Question Question
XL 2010 Envoi de mail en VBA avec liens hypertextes [RESOLU]
Réponses
12
Affichages
6 K
olivier974s
O
J
  • Question Question
Insérer Tableau Excel dans Corps d'un message mail
Réponses
12
Affichages
12 K
Roland_M
Roland_M
S
  • Question Question
Tableau + Formulaire + Destinataires + Outlook = possible ou pas ?
Réponses
2
Affichages
2 K
Silmeria
S
cibleo
  • Question Question
Problème avec While wend ou avec l'argument passé
Réponses
9
Affichages
2 K
cibleo
cibleo
Retour