Office: Kopieren Excelbereich in Outlook Mail mit VBA

Hallo,

ich versuche einen markierten Bereich eines Excel-Arbeitsblattes über eine VBA-Funktion in den Body eines Outlook-Mails zu kopieren. Leider finde ich bisher keinen Befehl, der mir das Copy aus dem Excel quasi in ein Paste des Outlooks verwandelt. Kennt da jemand eine Lösung - oder ein gutes VBA-Buch für Outlook ?

Herzlichen Dank !

Viele Grüße

M.Schnell

:)

 

Hallo Michael,

so einfach geht das leider nicht. Wenn du den Tabellenbereich tatsächlich als Tabelle im Mailbody haben willst, musst du diesen in HTML-Code umsetzen. Eine gute Beschreibung dafür findest du im Internet bei selfhtml. Und dann gibt es natürlich noch das Problem, das Ganze dynamisch zu gestalten, d.h. entsprechend der Anzahl von Zeilen/Spalten der Markierung. Der HTML-Code wird dann nicht dem "Body" der eMail zugewiesen, sondern dem "HTMLBody".

Gruß Ingolf

 

Hallo Michael,

das ist eigentlich nicht so schwer. Aber frag mich nicht nach html, da kenn ich mich nicht aus.

Code:

 

Option Explicit


Public Sub prc********()
Dim Bereich As Range
Set Bereich = Application.Selection
MsgBox Bereich.Address
Dim objOutlook As Object, objMail As Object
Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "Mailadresse@irgendwo.de"
.Subject = "Hallo"
.HTMLBody = fncRangeToHtml("Tabelle1", Bereich.Address) 'Anpassen !!!
.Display 'zum testen
' .Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub

Private Function fncRangeToHtml(strWorksheetname As String, _
strRangeaddress As String) As String
Dim objFilesytem As Object, objTextstream As Object
Dim strFilename As String
strFilename = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=strWorksheetname, _
Source:=strRangeaddress, _
HtmlType:=xlHtmlStatic).Publish True
Set objFilesytem = CreateObject("Scripting.FileSystemObject")
Set objTextstream = objFilesytem.GetFile(strFilename). _
OpenAsTextStream(1, -2)
fncRangeToHtml = objTextstream.ReadAll
objTextstream.Close
Set objTextstream = Nothing
Set objFilesytem = Nothing
Kill strFilename
End Function