Sub
Mail_Senden()
Dim
WSh
As
Worksheet, WkS
As
Worksheet
Dim
sMailtext
As
String
, sBild
As
String
, sSignatur
As
String
Dim
sBer
As
String
, iEinf
As
Integer
sBer =
"A20:K33"
Set
WSh = ThisWorkbook.Sheets(
"Tabelle1"
)
On
Error
Resume
Next
Do
WSh.Range(sBer).CopyPicture Appearance:=xlScreen, Format:=xlBitmap
If
Err.Number = 0
Then
Exit
Do
Err.Clear
Loop
With
CreateObject(
"Outlook.Application"
).CreateItem(0)
.BodyFormat = 2
.Subject =
"Crate and Weight Size"
.
To
=
"Mail@test.de"
sMailtext =
"Hi ,"
& vbLf & vbLf &
"Crate and weight size for "
_
& WSh.Range(
"F20"
).Value &
":"
& vbLf & vbLf
.Getinspector: sSignatur = .htmlbody
.htmlbody = Replace(sMailtext, vbLf,
"<br>"
) & sSignatur
.Display
iEinf = Len(sMailtext) - 1
With
.Getinspector.WordEditor.Application.Selection
.Start = iEinf: .
End
= iEinf
.Paste
End
With
End
With
End
Sub