Envoyer un mail outlook avec VBA

**candyneige** · 22/07/2019, 18h16

Bonjour à vous.

J'ai encore besoin de vous

Comment écrire le corps d'un mail avec Body ou Htmlboby sur VBA Excel?

je dois faire une macro qui permet d'envoyer des mails après sélection des compagnies dans un tableau Excel. Je dois également insérer un tableau dans le texte, comme vous pouvez le voir en exemple.

Voici mon texte:

Dear XXX,

We would like to draw your attention to the fact that, errors and omissions excepted, our record show that you owe us the amount of XXX € corresponding to the following invoice:

test.xlsx

Please find enclosed the above mentioned invoice for your reference.

We are kindly asking you to proceed to the due payment at your earliest convenience and we thank you in advance.

We remain at your disposal for any further queries.

Thank you in advance and please do not hesitate to contact us at 123456987@gmail.com should you have any questions.

Comment je peux entrer ce texte sous vba avec la fonction "body" et insérer le tableau que je copie d'un classeur Excel?

Merci

**Zekraoui_Jakani** · 23/07/2019, 10h10

Il vaut mieux mettre le fichier Test.xlsx en annexe sous format PDF (c'est la pratique générale)
ajouter l'annexe dans les commandes outlook
adapter le message en remplaçant "corresponding to the following invoice:" par "corresponding to the invoice in attachment" ou par "corresponding to the attached invoice".

Pour un message avec Body ou Htmlboby sur VBA Excel, il y a suffisamment de littérature à ce sujet sur ce forum (qui cherche, trouve)

**candyneige** · 29/07/2019, 16h09

Bonjour, Je reviens encore vers vous parce que cette fois ci, je dois écrire un mail à la suite d'un ancien mail. J'ai réussi à trouver comment envoyer un mail Outlook avec vba grâce au forum, maintenant il me faut insérer un ancien mail (c'est à dire celui qui a été envoyé avant le nouveau mail) et un tableau, c'est à dire copier un tableau de excel et le coller dans le corps du mail. Je ne sais pas comment le faire. voici mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub envoi_email(ByVal Sujet As String, ByVal Destinataire As String, ByVal dest_cc As String, ByVal ContenuEmail As String, Optional ByVal PieceJointe As String, Optional ByVal PieceJointe2 As String)
 
 
On Error GoTo EnvoyerEmailErreur
 
'définition des variables
Dim oOutlook As outlook.Application
Dim WasOutlookOpen As Boolean
Dim oMailItem As outlook.MailItem
Dim Body As Variant
Dim rng As Object
Dim contactname As String
Dim rem_amount As Integer
 
 
Body = ContenuEmail
 
    'vérification si le Contenu du mail n'est pas vide. Si oui, email n'est pas envoyé. Si vous voulez pouvoir envoyer les email vides, mettez en commentaire les 4 lignes de code qui suivent.
    If (Body = False) Then
        MsgBox "Mail non envoyé car vide", vbOKOnly, "Message"
        Exit Sub
    End If
 
    'préparer Outlook
    PreparerOutlook oOutlook
    Set oMailItem = oOutlook.CreateItem(0)
 
    'création de l'email
    With oMailItem
        .To = Destinataire
        .CC = dest_cc
        .Subject = Sujet
 
        'CHOIX DU FORMAT
        '----------------------
        'email formaté comme texte
        .BodyFormat = olFormatRichText
        .Body = Body
            'OU
 
        'email formaté comme HTML
            '.BodyFormat = olFormatHTML
            '.HTMLBody = "<html><p>" & Body & "</p></html>"
        '----------------------
 
        If PieceJointe <> "" Then .Attachments.Add PieceJointe
        If PieceJointe2 <> "" Then .Attachments.Add PieceJointe2
 
       .Display   '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
       .Save      '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)
      ' .Send      '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
    End With
 
   'nettoyage...
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
 
   Exit Sub
 
EnvoyerEmailErreur:
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing
 
    MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub PreparerOutlook(ByRef oOutlook As Object)
 
 
'------------------------------------------------------------------------------------------------
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.
'------------------------------------------------------------------------------------------------
On Error GoTo PreparerOutlookErreur
 
 
On Error Resume Next
    'vérification si Outlook est ouvert
    Set oOutlook = GetObject(, "Outlook.Application")
 
    If (Err.Number <> 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    Else    'si Outlook est ouvert, l'instance existante est utilisée
        Set oOutlook = GetObject("Outlook.Application")
        oOutlook.Visible = True
    End If
    Exit Sub
 
PreparerOutlookErreur:
    MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."
 
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Function WorksheetExists(WSName As String) As Boolean 'Pour verifier qu'un classeur excel existe bel et bien
    On Error Resume Next
    WorksheetExists = Len(Worksheets(WSName).Name) > 0
End Function

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
Sub envoiemail()
 
Dim CustomerNum As String      'permet de récupérer la donnée de la colonne A
Dim costumername As String     'permet de récupérer la donnée de la colonne B
Dim contactname As String      'permet de recuperer la donnée de la colonne C,E,G,I,K
Dim Email As String            'permet de récupérer la donnée de la colonne D,F,H,J,L
Dim consultant As String       'permet de récupérer la donnée de la colonne M
Dim rem_amount As Integer      'permet de récupérer la donnée de la colonne H 234 dans la fenetre "Unpaid_details
Dim Monsujet As String
Dim Mondestinataire As String
Dim Mondestinatairecc As String
Dim Moncontenu As String
Dim MaPieceJointe As String
Dim MaPieceJointe2 As String
Dim CP As Worksheet            'variable permettant de stocker la valeur du classeur "Companies"
Dim UD As Worksheet            'variable permettant de stocker la valeur du classeur "Unpaid_detail"
Dim LineNB, ColNB As Long      'variable permettant de récupérer la ligne sélectionnée
Dim i As Integer
Dim outlookObj As Object
Dim R As Excel.Range
Dim Num_invoice As Variant
Dim rng As Range
' copier_tab Macro
 
 
 
For Each R In Selection
 
 
    If R.Value = "Company concerned" Then
         costumername = Left(Range("F2"), 31)
    Else
         costumername = Left(R, 31)
    End If
 
    If WorksheetExists(costumername) = False Then '(verifie que la feuille correspondant au ticker d'une société n'existe pas afin de la créer
        Sheets.Add , Sheets(Sheets.count)
        Sheets(Sheets.count).Name = costumername     'ajoute une nouvelle feuille
    End If
 
If WorksheetExists(costumername) = True Then
        Application.DisplayAlerts = False
        'Worksheets(costumername).Delete
        Application.DisplayAlerts = True
End If
 
 
 
        Sheets("Unpaid_details").Select
        Range("f1").Select
        Selection.AutoFilter
        ActiveSheet.Range("$D$1:$K$229").AutoFilter Field:=3, Criteria1:= _
        R.Value
        Range("F1:K230").Select
        Selection.Copy
        Sheets(costumername).Select
        ActiveSheet.Paste
 
        'afficher les noms et mails des personnes à qui envoyer le mail.
    Set UD = Worksheets(costumername)
    UD.Range("H1") = "Contact Name"
    UD.Range("I1") = "Email Address"
    UD.Range("J1") = "Consultant"
 
    UD.Range("H2") = Application.WorksheetFunction.VLookup(UD.Range("A2"), Sheets("Unpaid_details").Range("$f$1:$n$230"), 7, False)  'contactname
    UD.Range("I2") = Application.WorksheetFunction.VLookup(UD.Range("A2"), Sheets("Unpaid_details").Range("$f$1:$n$230"), 8, False)   'consultant
    UD.Range("j2") = Application.WorksheetFunction.VLookup(UD.Range("A2"), Sheets("Unpaid_details").Range("$f$1:$n$230"), 9, False)   'mail
 
 
 
    Sheets("Unpaid_details").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
 
UD.Select
concatene = UD.Range("e2").Value
For n = 3 To UD.Range("e65536").End(xlUp).Row - 1
    concatene = concatene & "; " & Sheets(costumername).Range("e" & n).Value
Next
 
 
UD.Range("k1") = "Invoices N°"
UD.Range("k2").Value = concatene     'Invoices number
 
 
    contactname = UD.Range("H2")
    Email = UD.Range("I2")
    consultant = UD.Range("J2")
 
' MsgBox = vbOK("Please don't forget to deselect the cells before you start again")
 
'
 
 
'Nous utilisons la feuille de chaque compagnie "
 
linemb = UD.Cells(Rows.count, "f").End(xlUp).Row
 
rem_amount = UD.Cells(linemb, 6)
Num_invoice = UD.Range("K2")
 
 
 
Monsujet = R.Value + " Invoices - " + Num_invoice
Mondestinataire = Email
Mondestinatairecc = "accounting@1254855655.eu;candy@515616516556.fr;Nunknjer@bubububvuerv.eu;" + consultant
 
 
     Set rng = UD.Range("A1:f7")
 
 
Moncontenu = "Dear Mr " & contactname & "," & vbCrLf & "We would like to draw your attention to the fact that, errors and omissions excepted, our records show that you owe us the amount of " & rem_amount & ",00 € corresponding to the following invoice:" & vbCrLf & "Please find enclosed the above mentioned invoice for your reference." & vbCrLf & "We are kindly asking you to proceed to the due payment at your earliest convenience and we thank you in advance. We remain at your disposal for any further queries." & vbCrLf & "Thank you in advance and please do not hesitate to contact us at <a href="mailto:accounting@1254855655.eu">accounting@1254855655.eu</a> should you have any questions."
 
MaPieceJointe = "S:\PARIS-VAT\VATSystems_PRODUCTION\PROCESS_ACTIVITY\CLIENTS\PLMJ\Invoicing\2018\M2 - nothing to invoice\SVD - M2 2018 - nothing to invoice.msg"
 
 
Call envoi_email(Monsujet, Mondestinataire, Mondestinatairecc, Moncontenu, MaPieceJointe, MaPieceJointe2)
 
Next R
 
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Function RangetoHTML(ByVal rng As Range)
    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"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
 
        .Cells(1).PasteSpecial Paste:=12
        .Cells(1).PasteSpecial Paste:=-4122
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            .Columns.AutoFit
            .Rows.AutoFit
        On Error GoTo 0
    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=")
 
    TempWB.Close savechanges:=False
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
 
End Function

en fait en sélectionnant plusieurs cellules qui contiennent le nom des clients, je crée les feuilles de chaque entreprise avec le tableau qui contient leur données et c'est ce tableau qui est sensé être copié dans le mail.

Je vous envoie un fichier excel pour vous montrer de quoi je parle. Il n'est pas fini parce que je n'ai pas encore ajouté certaines restrictions. Pensez à sélectionner les compagnies qui sont dans la page "unpaid_details"

Voila. Vos idées sont les bienvenues. Je suis en apprentissage de VBA. Je ne maîtrise pas encore beaucoup de choses.

merci pour votre compréhension.

Envoyer un mail outlook avec VBA

Macros et VBA Excel

Discussions similaires

Partager

Partager