Sub versuches()
Dim OutApp As Object, Mail As Object, i
Dim Nachricht
Set OutApp = CreateObject("Outlook.Application")
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.Subject = "TT Training"
.To = "@freenet.de"
.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("A2:A9"))
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
Application.Wait (Now + TimeValue("0:00:05"))
End Sub
Private Function RangeToHTML(objSheet As Worksheet, objRange As Range) As String
Dim strFilename As String
strFilename = Environ$("TEMP") & "/" & Format(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"
ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=objSheet.Name, _
Source:=objRange.Address, _
HtmlType:=xlHtmlStatic).Publish True
RangeToHTML = CreateObject("Scripting.FileSystemObject"). _
GetFile(strFilename).OpenAsTextStream(1, -2).ReadAll
Kill strFilename
End Function