Envoi mail avec sélection de cellule

Le 20/07/2021 à 12:32

Bonjour à tous,

Grand lecteur de l'ombre de ce forum depuis plusieurs mois, j'ai réussi à accomplir beaucoup de choses déjà grâce aux informations en or que l'on trouve ici!

Néanmoins, je me lance désormais dans la création de ce sujet pour solliciter un peu de votre aide car je n'ai pas trouver solution à mon problème.

Mon problème est le suivant et est fort semblable à celui de ce monsieur sur ce topic (https://forum.excel-pratique.com/excel/envoyer-un-mail-avec-une-selection-de-cellules-t81065.html). Comme lui j'ai un fichier avec des lignes de commandes. J'aimerais contacter par mail via outlook chaque client (colonne C) avec son adresse mail correspondante (colonne N) et dans le corps du mail lui mettre la liste des lignes qui correspondent à son cas.

La macro crée dans l'ancien sujet correspond parfaitement à mes besoins mais je n'arrive pas à l'adapter à mon cas personnel.

J'imagine que cela est possible et surement très simple d'adapter la macro à mon cas c'est pourquoi je sollicite votre aide!

Ci joint mon fichier et le code de la personne précédente :

Sub filtre()
Dim plg As Range
Dim strbody As String
Dim fich As Variant
Dim ShT As Worksheet

fich = Application.GetOpenFilename("Tous les fichiers (*.xlsx),*.xlsx")
If fich = False Then Exit Sub

Workbooks.Open fich
Application.ScreenUpdating = False
With Sheets(1)
Sheets.Add
Set ShT = ActiveSheet
    'définition de la plage de données initiale
    Set plg = .Range("A4:H" & .Cells(Rows.Count, 1).End(xlUp).Row)
    'copie dans une colonne provisoire le nom des mails qu'il faudra creer/filtrer
    .[D:D].Copy .[O1]
    'supprime doublons
    .[O:O].RemoveDuplicates Columns:=Array(1), Header:=xlYes
    'utilisation de deux cellules provisoires une pour l'entete de recherche
    .[P1] = .[D4]
    'on passe en revu tous les job différents
    For i = 4 To .[O65536].End(xlUp).Row
    ShT.[A1].CurrentRegion.Delete
        'l'autre le job a rechercher
        .[p2] = .Range("O" & i)
        'filtre avancé avec copie immédiate
        plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.[P1:P2], CopyToRange:=ShT.[A1]
        ShT.Range("A:H").EntireColumn.AutoFit
        ShT.Rows(1).Insert
        ShT.[A1] = "Bonjour, voici les projets a suivre. Merci"
        strbody = RangetoHTML(ShT.Range("A1:G" & ShT.Cells(Rows.Count, 1).End(xlUp).Row))
        EnvoiAutomatiqueMail strbody, .[p2]
    Next i
End With
ActiveWorkbook.Close False
End Sub
Public Sub EnvoiAutomatiqueMail(strbody As String, adresse As String)
Dim OutlookApp As Object
Dim OutlookMail As Object
'Dim adresse As String
Dim message As String
Dim sujet As String
Dim i As Integer
        sujet = "PROJETS A SUIVRE"
        Set OutlookApp = CreateObject("outlook.application")
        Set OutlookMail = OutlookApp.createitem(0)
            With OutlookMail
            .Subject = sujet 'sujet du mail
            .To = adresse 'adresse mail destinataire
            .HTMLBody = strbody
            .Display 'affiche le mail
            '.send 'on envoie le mail créé
            End With
End Sub
Function RangetoHTML(rng As Range)
' Working in Office 2000-2007
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Bien cordialement,

25fichier.xlsx (120.50 Ko)
Le 20/07/2021 à 15:15

Bonjour Edouard

Essaie quelque chose comme cela

Bien sûr, il ne faut sûrement pas inclure le nom du client dans le contenu et peut-être voudras-tu mettre un nom parlant devant chaque champ

52mail.xlsm (136.76 Ko)

Je ne peux pas tester...

bon courage

Le 20/07/2021 à 15:43

Bonjour Patty!

Tout d'abord merci beaucoup pour ton aide, cela correspond exactement à mon besoin! 1000 merci!

Juste, j'ai 6 messages qui apparaissent de ce type :

capture d ecran 2021 07 20 154237

Dans la réalité, j'aurais plus de 300 mails donc est-il possible de supprimer l'apparition de ces messages?

Bien cordialement,

Le 20/07/2021 à 15:49

Désolée...mais contente que cela te convienne

Supprime : MsgBox Contenu

Je l'avais mis pour tester et ai oublié de le retirer...

Bye

Le 20/07/2021 à 16:13

Encore merci, c'est vraiment parfait !

Bien cordialement,

Le 21/07/2021 à 12:05

Bonjour

Pense à marquer ton sujet comme résolu si cela marche comme tu veux.

Bonne journée

Le 22/07/2021 à 12:33

Bonjour,

Petite mise à jour sur mon sujet, la commande macro marchait très bien mais je me suis aperçu qu'une bonne moitié des mails ne s'étaient pas générés et en regardant le code je n'ai aucune idée du pourquoi Si un mail ne se génère pas c'est qu'il ne reconnait pas le client mais je n'arrive pas à modifier le code pour que cela sélectionne les récalcitrants.

10copie-de-copie-de-listing-v2-002.xlsm (24.06 Ko)

Je vous remets le fichier avec des lignes qui ne fonctionnent pas sans que je ne comprenne pourquoi...

J'ai également très légèrement modifié le code pour qu'il s'adapte à mon corps de mail mais rien qui ne touche à la sélection des lignes à envoyer.

Private Sub CommandButton1_Click()

Dim messagerie As Variant
Set messagerie = CreateObject("Outlook.Application")
DLig = Range("A65536").End(xlUp).Row
Client = ""
For lig = 2 To DLig
    If Range("A" & lig) <> Client Then
        If Client <> "" Then
            With messagerie.CreateItem(olMailItem)
                .To = MailCli
                .Subject = "Retrait"
                .Body = Contenu
                .Display
            End With
        End If
suit:
        Contenu = Range("L15") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L16") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L17") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L18") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L19") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("L20") & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("A" & lig) & " / " & Range("B" & lig) & " / " & Range("C" & lig) & " / " & Range("D" & lig) & " / " & Range("E" & lig) & " " & Range("F" & lig) & " / " & Range("G" & lig)
        MailCli = Range("H" & lig)
        Client = Range("A" & lig)
    Else
        Contenu = Contenu & vbCrLf & Range("A" & lig) & " / " & Range("B" & lig) & " / " & Range("C" & lig) & " / " & Range("D" & lig) & " / " & Range("E" & lig) & " / " & Range("F" & lig) & " / " & _
        Range("G" & lig) & " / " & Range("H" & lig)

    End If
Next
    With messagerie.CreateItem(olMailItem)
        .To = MailCli
        .Subject = "Retrait"
        .Body = Contenu
        .Display
    End With
End Sub

Bien cordialement,

Le 22/07/2021 à 13:45

Bonjour à tous,

Sinon autre manière de faire :

38edouard-depouhon.xlsm (146.30 Ko)

Lance la macro, tu peux voir à quoi ressemble les mails dans tes mails envoyés

Je pense que tu pourrai même styliser le tableau en css si le cœur t'en dit !

Bonne journée,

Baboutz

Edit : L'avantage, c'est que tu peux choisir les données que tu veux placer, mettre le corps de texte que tu veux dans ton mail. Le seul inconvénient, c'est qu'on est obligé de "construire" la signature du mail pour que ce soit automatique.

Le 22/07/2021 à 14:24

Bonjour Babtouz,

Le code que tu proposes est vraiment très poussé et très bien expliqué dans son détail. Il résout tous mes problèmes en plus !

Je me demande comment c'est possible d'acquérir un tel niveau en VBA c'est vraiment impressionnant ^^

Merci beaucoup pour ton temps

Bien cordialement,

Le 22/07/2021 à 16:13

Re,

Merci ! C'est une macro que j'ai déjà eu à faire pour le boulot, je l'ai juste adapté à ton cas

N'oublie pas d'utiliser des tableaux structurés, c'est un outil hyper efficace et qui fait gagner du temps...

Je me suis lancé dedans il y a 3ans, j'étais très nul mais en pratiquant on s'améliore !

Bonne journée,

Baboutz

Le 28/07/2021 à 15:58

Bonjour,

@Baboutz, Si tu actives ton .display en début de code (là où tu l'as bien mis), la signature se met automatiquement et tu n'as pas à la construire, non ?

Le 28/07/2021 à 17:46

Salut @JoyeuxNoel,

Oui tu as raison, l'inconvénient c'est que tu es obligé de valider à la main, et si tu as plusieurs mails, un peu pénible, non ?

Ou alors, c'était pour éviter les "flashs" sur l'écran, je ne sais plus, mais je m'étais dit que c'est la méthode la plus pratique sur le long terme !

Rechercher des sujets similaires à "envoi mail selection"