bonjour à tous,

A l'aide de la FaQ Developpez et l'aide de Microsoft j'ai réussi à coder une macro excel qui me permet d'envoyer un mail à des listes d'utilisateurs.
La génération du mail et son envoi marche très bien mais le corps du mail n'est pas ce que je souhaite.
Pour le corps du mail je dois sélectionner un document word et copier son contenu.
Mais ce que j’envoie par mail est du text brut. J'ai perdu la mise en page, les tableaux les couleurs etc...
Il y a surement quelque chose que je rate mais je ne trouve pas quoi. Les exemples que je trouve envoient le word en pj mais ce n'est pas ce que je souhaite faire.

Des pistes pour que je me corrige ?

Merci

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
Sub SendOutlookMessages()
 
    Dim OL As Object, MailSendItem As Object
    Dim W As Object
    Dim MsgTxt As String, SendFile As String
    Dim MsgTotal As Variant
    '******************************
    '***********WORD***************
    '******************************
    'Selection du document word à envoyer
    SendFile = Application.GetOpenFilename(Title:="Select MS Word " & _
        "file to mail, then click 'Open'", buttontext:="Send", _
        MultiSelect:=False)
 
    'Ouverture du document word
    Set W = GetObject(SendFile)
 
    'Recupération du contenu du document
    MsgTotal = W.Range(Start:=W.Paragraphs(1).Range.Start, _
       End:=W.Paragraphs(W.Paragraphs.Count).Range.End)
 
    'Arret de la session word
    Set W = Nothing
    '******************************
    '***********FIN WORD***********
    '******************************
 
    '******************************
    '***********OUTLOOK************
    '******************************
    'Creation d'un mail Outlook
    Set OL = CreateObject("Outlook.Application")
    Set MailSendItem = OL.CreateItem(olMailItem)
 
 
    'Récupération de mes listes de mails dans le classeur excel
    Dim ArrayListeDesMails As Variant
    Sheets("Liste Appli").Activate
    ArrayListeDesMails = ActiveSheet.ListObjects("TableauListeDesMails").DataBodyRange
 
    'Pour chaque liste de mails
    For Each liste In ArrayListeDesMails
        'Creation du message et envoi
        With MailSendItem
            .Subject = SendFile
            .HTMLBody = MsgTotal
            '.Body = MsgTotal
            .To = liste
            .Sender = "moi@moi.fr"
            .Send
        End With
 
    Next
 
    Set OL = Nothing
    '******************************
    '***********FIN OUTLOOK********
    '******************************
 
End Sub