Tabelle per RangeToHtml in der Mail positionieren
16.12.2016 15:15:04
Mario
ich arbeite schon ein paar Tage an einem Makro und es gibt eine Sache, die ich
trotz googlen, suchen etc. nicht hinbekomme.
Ich kopiere eine Tabelle aus einem Excel-Sheet und möchte Sie in der Mail
einfügen.
Das klappt prinzipiell schon, leider aber von der Formatierung nicht.
Ich verwende diese RangeToHtml-Funktion:
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
Ich muss zugeben, dass ich die Funktion kopiert und leicht modifiziert habe und nicht 100% verstehe.
Da wäre ich schon für kleine Erläuterungen dankbar.
Kann man hier noch irgendwo align=left oder so einfügen?
Aufgerufen wird die Funktion folgendermaßen:
Public Sub Beispiel(str_startzeile As String, str_endzeile As String)
'Outlook Automatisierungssitzung durch "späte Bindung"
'Variablen Deklarieren und Dimensionieren
Dim objOutlook As Object
Dim objMail As Object
'Das hier war nur für eine Sendkeys variante, wobei diese auch nicht zufriedenstellend war. _
_
_
Dadurch wurde die Tabelle über dem kompletten Text eingefügt
ActiveSheet.Range("C" & str_startzeile & ":Q" & str_endzeile).Select
Selection.Copy
'Objektvariable wird auf Outlook-Application-Objekt festgelegt (Obj in oberster Ebene im _
Outlook-Objektmodell
'->muss zuerst ein Outlook-Application-Objekt definiert werden, um auf alle anderen _
Outlook-Objekte zugreifen zu können.
Set objOutlook = CreateObject("Outlook.Application")
'Ein neues Default-Item als Task erstellen
Set objMail = objOutlook.CreateItem(0)
'with um mehrere Dinge mit einem Objekt durchzuführen
With objMail
.To = "bla@bla.de" 'Empfänger
.cc = "bla@bla.de" 'CC-Empfänger
.Subject = "Betreff" 'Betreff
.Importance = 2
.HtmlBody = "Hallo zusammen, bitte um Überprü _
fung des folgenden Makros" & RangeToHTML(ActiveSheet, ActiveSheet.Range("C" & str_startzeile & ":Q" & str_endzeile)) &_
"Mit freundlichen Grüßen"_
"Signatur Zeile 2"
.Display 'nur Anzeigen
'.Send 'direkt senden
End With
Set objMail = Nothing
Set objOutlook = Nothing
Ich übergebe im htmlbody an die Range-Funktion mit den erhaltenen Zeilenwerten
Es wird auch der gewünschte Bereich eingefügt, allerdings stark nach rechts versetzt im Verhältnis zum Text. Ich denke es müsste reichen, wenn ich das align=left
mitgeben könnte.
Als Notlösung wäre auch ein Tipp wie ich Sendkeys so verwenden kann, dass es zwischen dem gewollten Text eingefügt wird. Aber lieber wäre mir eine HTML Lösung