Bonjour à tous,

J'ai une macro qui envoi un mail automatiquement via un fichier excel.
Dans le corps du mail je veux insérer un texte mais également un tableau issu de mon fichier excel.
Le problème est que lorsque le mail se crée il affiche bien le tableau dans le corps du message mais pas le texte. J'ai essayé séparément et il m'affiche bien le texte tout seul et le tableau tout seul mais pas les deux ne même temps.
J'ai beau chercher je ne vois pas comment résoudre le problème.

Merci d'avance de votre aide.

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
 
Code:
Sub envoi_mail()
 
Dim appOutlook As Outlook.Application
Dim mailOutlook As Outlook.MailItem
Dim emlBody1 As String, emlBody2 As String, sendTo As String
Dim wkbook As String
Dim rng As Range
Dim lastfilline As String
 
 
lastfilline = Range("J65536").End(xlUp).Row
 
For i = 1 To lastfilline
 
    If Cells(i, 1).Value = "COMMENT" Then
 
        cpty = Cells(i + 1, 10).Value
        contact = Sheets("contact mail").Range("A1:B30")
 
        Set appOutlook = New Outlook.Application
        Set mailOutlook = appOutlook.CreateItem(1)
 
 
        On Error Resume Next
        sendTo = WorksheetFunction.VLookup(cpty, contact, 2, False)
 
        emlBody1 = "Hi," & "<br><br>" & _
                  "Please confirm /infirm booking details bellow" & "<br><br>" & "Thanks" & vbCrLf & vbCrLf
 
        emlBody2 = "Thanks" & "<br><br>"
 
        Set rng = Nothing
        On Error Resume Next
        Set rng = Sheets("ecart " & D & " " & M & " " & Y).Range(Cells(i, 1), Cells(i, 13).End(xlDown))
        On Error GoTo 0
 
        If rng Is Nothing Then
            MsgBox "The selection is not a range or the sheet is protected" & _
                    vbNewLine & "please correct and try again.", vbOKOnly
            Exit Sub
        End If
 
        With mailOutlook
            '.To = sendTo
            .HTMLBody = emlBody1 & RangetoHTML(rng) & emlBody2
            .Subject = cpty & " Collat Break "
            .Display
        End With
 
    End If
 
Next i
 
Set appOutlook = Nothing
Set mailOutlook = Nothing
 
 
End Sub