Envoyer mail avec Excel via VBA

Le 08/03/2024 à 11:12

Bonjour,

Tout d'abord merci de l'attention que vous allez porter à ma demande.

Chaque mois, je dois envoyer un mail a 20aine de personnes à partir d'un fichier excel, Donc je tri par personne puis je fait un copier coller et je fait un mail manuellement séparé pour chaque personne (qui est le meme en forme mais le contenu est différent).

A partir d'un tableau général excel, je souhaiterais que chaque personne reçoivent en PJ la partie du tableau qui les concerne(les lignes qui le concerne, sachant que le nombre lignes par personne peut changer de mois en mois et que l'adresse mail change en fonction de la personne (idéalement la recupérer dans une cellule par ex.))

A partir d'un bouton le mail envoyé serait :

"Bonjour

En pj ton tableau récap

Merci de confirmer stp

Cdt"

PJ : Tableau recap

En fouillant j'ai réussi a trouver un code permettant d'envoyer uniquement le tableau entier mais je n'arrive pas a lui faire comprendre qu'il doit récuperer uniquement les lignes de la personne concerné et récupérer l'adresse mail dans la bonne cellule.

Option Explicit

Public Sub SendMail()
Dim MaMessagerie As Object, MonMessage As Object
Dim Destinataire As String, Contenu As String

Set MaMessagerie = CreateObject("Outlook.application")
Set MonMessage = MaMessagerie.CreateItem(0)
MaMessagerie.Session.Logon

Destinataire = ActiveSheet.Cells(2, 2).Value

Contenu = "Bonjour," & Chr(10) & Chr(13)
Contenu = Contenu & "Merci de me confirmer" & Chr(10) & Chr(13)
Contenu = Contenu & "Si tu constates une ou plusieurs anomalies merci de m'en fait part rapidement" & Chr(10) & Chr(13)
Contenu = Contenu & "Cordialement" & Chr(10) & Chr(13)

With MonMessage
.To = Destinataire
.CC = ""
.Subject = "Confirmation Observations"
.Body = Contenu
.Attachments.Add ActiveWorkbook.FullName
.Display '

End With

Set MonMessage = Nothing: Set MaMessagerie = Nothing

End Sub

Par avance merci beaucoup pour votre lecture et pour votre aide.

25sheet1.xlsx (23.39 Ko)


Edit modo :Je vois que lorsque vous postez un code vous n'utilisez jamais les balises prévues.
Merci d'utiliser les balises de codes en cliquant sur l'icone </> disponible dans le menu et en collant le code dans la fenêtre. Il sera plus facile à lire.
J'ai corrigé votre post

Le 08/03/2024 à 11:34

tu peut écrire un mailbody qui te permeteras de bien ecrir le texte de ton mail

Dim ws As Worksheet
    Dim cel As Range
    Dim mailBody As String

mailbody="tu ecrit ce que tu veut ou "& vbCrLf & _
                    "Type : "& ws.Cells(cel.Row, "A").Value & vbCrLf & _             '(on choisissant la case  et la colonne que tu veut mettre dans le mail)(ici il envoi la cellule que je viens de modifier de la colonne A)
                    "Type : "& ws.Cells(cel.Row, "A").Value & vbCrLf & _     
                    "Type : "& ws.Cells(cel.Row, "A").Value & vbCrLf & _     
                    "Type : "& ws.Cells(cel.Row, "A").Value & vbCrLf & _     
                    "pour avoir plusieur ligne: "& ws.Cells(cel.Row, "A").Value & vbCrLf &  vbCrLf

Pour finir le mail il faut qu'il est

Value & vbCrLf &  vbCrLf

et pour retourner a la ligne assure toi qu'il est a chaque fois

Value & vbCrLf & _

j'ai pas bien compris ce que tu veut envoyer par mail donc je ne sais pas comment tu le veut mais si tu fait une boucle if/end if ou ajouter un bouton pour identifier ceux que tu enverras le message pourfacilité le tri

Le 08/03/2024 à 14:46

Bonjour Tinayli,

Merci pour ta réponse et pour ton code qui me seras très utile et que je trouve plus élaboré :)

Le seul inconvenient est que le nombre de ligne dépend de la personne.

J'ai fait un petit doc word pour expliquer ce que je souhaite, que je joint à mon message.

Pour ce qui est du tri, si je crée des segments est-ce que cela peut faciliter la commande ?

Merci à toi d'avance pour ton temps et ton aide et tous ceux qui prendront le temps de me lire

16new-microsoft-word-document.docx (295.93 Ko)
Le 08/03/2024 à 14:59

salut

si tu fait un segment cela ne fonctionneras pas parce que les ligne elle sont toujours las bas mais qu'ils font 0mm et est ce que tu peut dire un peut plus sur comment tu choisiras la personne comme j'ai dit avant avec une commande if tu peut facilement t'occuper du le tri et pour envoyer le tableaux je ne sais pas.

je suis aussi sur un projet ou je doit envoyer un mail quand on arrive a une limite et j'ai fait le code que je t'ai envoyer pour avoir ça

ce n'est pas en colonne mais

capture

ça fait l'affaire

Le 08/03/2024 à 15:21

Re,

Effectivement le segment ne marcheras pas 🤣

Je vais me pencher sur comment faire le tri avec une commande IF (je suis vraiment novice en la matière)

Pou répondre à ta question le tri se ferait uniquement sur "Inspector Email" colonne B dans mon fichier de base, l'adresse mail correspond à : prénom.nom@societe.fr

Contexte : Au cours du mois tous les salariés recoivent des "notifications", elles sont en fin de mois reporté dans un tableau (celui que j'ai envoyé en masquant les noms pour respecter la charte du forum), a la fin du mois je dois leurs envoyé un récap de ce qu'ils ont reçu afin qu'il confirme ou non.

Ex : jean.dupont@societe.fr est présent dans 12 lignes dans ce tableau

Extraire les 12 lignes qui concerne Jean Dupont pour lui envoyer par mail afin qu'il confirme.

Soit sur un fichier excel ou pdf(au plus simple) séparé en PJ soit dans le corps du mail sous forme de tableau. (cf doc word)

Encore merci :)

PS : merci au modo d'avoir corrigé mon message initial, je serais plus vigilant à l'avenir

Le 09/03/2024 à 22:08

Bonjour ramzi, le fil et le Forum,

voici ma proposition:

Option Explicit

Dim TempFile2 As String

Sub mailRamzi()
'https://forum.excel-pratique.com/excel/envoyer-mail-avec-excel-via-vba-191775

    Dim OutApp As Object, OutMail As Object
    Dim myRng As Range, v As Variant
    Dim j As Long, lastRow As Long
    Dim strbody As String

    Application.ScreenUpdating = False

    lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v = Range("A2:Q" & lastRow).Value
    strbody = "Bonjour ," & "<br>" & _
                  "En pj ton tableau récap. Merci de confirmer stp" & "<br/><br>"

    Set OutApp = CreateObject("Outlook.Application")
    With CreateObject("scripting.dictionary")
        For j = 2 To UBound(v)
            If Not .exists(v(j, 3)) Then
                .Add v(j, 3), Nothing
                With ActiveSheet
                    .Range("A1").AutoFilter 3, v(j, 3)
                    Set myRng = .Range("A1:Q" & lastRow).SpecialCells(xlCellTypeVisible)

                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .To = v(j, 2)
                        .Subject = "Recap"
                        .HTMLBody = strbody & RangetoHTML(myRng) & "<br>Cordialement."
                        .Attachments.Add TempFile2
                        .Display
                       ' .send
                    End With
                End With
            End If
        Next j

    End With

    Range("A1").AutoFilter

    Application.ScreenUpdating = True
End Sub

Function RangetoHTML(myRng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim i      As Integer

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    myRng.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
        For i = 7 To 12
            With .UsedRange.Borders(i)
                .LineStyle = xlContinuous
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
                .Weight = xlMedium
            End With
        Next i
    End With

    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

    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=")

    TempFile2 = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".xlsx"

    With TempWB
    .SaveAs TempFile2
    .Close savechanges:=True
    End With

    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
    Application.Wait Now + #12:00:01 AM#

End Function

Cordialement

Le 11/03/2024 à 07:25

Bonjour Sequoyah,

Merci infiniment pour ton code c'est exactement ce que je cherchais. Il ne me reste plus qu'a changer le .display en .send.

Merci à tous,

Bonne journée et bonne semaine.

Rechercher des sujets similaires à "envoyer mail via vba"