Option
Explicit
Sub
InOutlookEinfügen()
Dim
oApp
As
New
Outlook.Application
Dim
oMail
As
Outlook.MailItem
Dim
strOldBody
As
String
Dim
Empfaenger
As
String
Dim
CcEmpfaenger
As
String
Dim
chtPicture
As
Chart
Dim
strSheetName
As
String
Empfaenger =
"email adresse1"
CcEmpfaenger =
"email adresse2"
strSheetName = Sheets(
"Benanntes Arbeitsblatt"
).Activate
ActiveSheet.Range(
"A2:M55"
).CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set
chtPicture = Charts.Add
Application.Wait Now + TimeSerial(0, 0, 7)
chtPicture.Paste
Application.Wait Now + TimeSerial(0, 0, 5)
chtPicture.Export ActiveWorkbook.Path &
"\" & strSheetName & "
.png"
Application.DisplayAlerts =
False
chtPicture.Delete
Application.DisplayAlerts =
True
Set
chtPicture =
Nothing
Set
oMail = oApp.CreateItem(olMailItem)
With
oMail
.GetInspector.Display
strOldBody = .HTMLBody
.BodyFormat = olFormatHTML
.Display
.
To
= Empfaenger
.CC = CcEmpfaenger
.Subject =
"Test"
.HTMLBody =
"<b>ANREDE</b>"
&
"<br>"
&
"<b>EMAIL TEXT</b>"
&
"<br><br>"
&
"<img src="
"file://O:\Adresspfad\Wahr.png"
">"
&
"<br><br><br>"
&
"<b>Viele Grüße<b/>"
& _
strOldBody
Worksheets(
"functions"
).Activate
Kill
"O:\Adresspfad\Wahr.png"
End
With
End
Sub