Mail outlook via macro

Version imprimable

Bonjour,

J'essaie d'envoyer un mail Outlook via une macro et pour le moment je suis bloqué sur un point et j'espère trouver la solution ici.
Voici mon code pour commencer:

Code:

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
Sub SendMail()
Dim shp, shp1 As Shape
 
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim doc As Word.Document
 
 
Set shp = ActiveSheet.Shapes("ZT")
Set shp1 = ActiveSheet.Shapes("ZoneText1")
 
Set ol = New Outlook.Application
Set mi = ol.CreateItem(olMailItem)
 
mi.Display
 
mi.To = shp.TextFrame.Characters.Text
mi.CC = shp1.TextFrame.Characters.Text
mi.Subject = "Suivi des recettes" & Range("J24") & "_" & Range("J1")
 
Set doc = mi.GetInspector.WordEditor
 
doc.Range(0, 0).InsertBefore "Bonjour," & vbNewLine & vbNewLine & "Veuillez trouver ci-après les informations relatives blabla." & vbNewLine & vbNewLine & _
"     I.  Overview " & Range("J24") & ":" & vbNewLine & vbNewLine & "Ci-dessous le nombre total des recettes" & vbNewLine & vbNewLine
 
ActiveSheet.Range("AM14:AR21").Copy
 
'Je souhaite coller le tableau copié dans la suite du corps du mail
 
End Sub

Mon objectif est simple, c'est de coller le tableau Range("AM14:AR21") dans la suite du corps du mail. Je n'arrive pas à le faire.
Pourriez-vous m'aider svp ?

Merci d'avance.

30/08/2020, 16h33
mfoxy

Ré-Bonjour,

Une petite recherche sur ce site, méthode : création du range en format html avec ou sans style CSS

https://www.developpez.net/forums/d1...cdo-style-css/

D'autres méthodes existent par exemple :

En collant la plage dans un fichier Word sauver en fichier html exemple sur le site de rondebruin
Ou encore en créant une image du range, et le coller en tant que tel dans l'email ( mais dans ce cas pas de copier coller dans le corps du mail possible par le destinataire )

Bat,
MFoxy
30/08/2020, 17h16
Heathcliff_1

Elle est un peu compliquée la méthode avec le HTML. Pas moyen de le faire avec GetInspector.WordEditor ?

Merci pour ton aide.

Bonjour,

Non testé. Remplacer la ligne 26 par ceci:
Code:

1 2 3 4 5 6 Dim wdRange As Word.Range Set wdRange = doc.Range(0, doc.Characters.Count) wdRange.InsertAfter vbCrLf ActiveSheet.Range("AM14:AR21").Copy wdRange.Paste Set wdRange = Nothing
Cela devrait marcher pour des tableaux simples (sans saut de ligne, etc.)
Cordialement.

@Eric Ca marche pas. En tout cas merci bien pour ton aide.
Finalement je l'ai fait avec le HTML. Voici le bout code que j'ai trouvé quelque part dans un ancien fichier:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub createJpg(Namesheet As String, nameRange As String, nameFile As String)
    ThisWorkbook.Activate
    Worksheets(Namesheet).Activate
    Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
    Plage.CopyPicture
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("TEMP") & "\" & nameFile & ".png", "PNG"
    End With
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
Set Plage = Nothing
End Sub

Et on rajoute ce bout au Sub de l'envoie du mail:

Code:

1
2
3
4
5
6
7
8
9
 
Call createJpg("Sheet", "B74:I143", "DashboardFile")
 
 TempFilePath = Environ$("TEMP") & "\"
            .Attachments.Add TempFilePath & "DashboardFile.png", olByValue, 0
 
            .HTMLBody = .HTMLBody _
                & "<img src='cid:DashboardFile.png'" _
                & "<br>"

Et tout va bien.