per Knopfdruck aus Excel eine E-Mail senden
15.08.2016 14:50:42
Kirstin
nicht böse sein, wenn diese Frage schon mal hier im Forum geschrieben war. Ich habe vieles schon durchstöbert und einiges gefunden, die zu meinem Problem passten.
Leider komme ich jetzt aber einfach nicht weiter.
Folgendes:
Ich möchte per Button eine E-Mail erzeugen (versenden soll der User selber). Der E-Mail Verteiler steht in der Zelle B1. Der Betreff in Zelle B2. Die eigentliche wichtige Tabelle ist eine Pivot-Tabelle, die vorher aktualisert wurde und gefilter ist auf das heutige Datum (das funktioniert schon). Die Tabelle befindet sich in dem gleichen Excel-Sheet, wie der Verteiler und der Betreff.
Da diese Pivot von Tag zu Tag unterschiedlich ist (also die länge nach unten), habe ich es erst mal so gelöst, dass der User den Bereich markieren muss, die in den Body der E-Mail soll. Hab auch noch etwas Text, der um die Tabelle in den Body soll und eine Signatur.
Soweit funktioniert mein Makro auch schon. Die E-Mail wird erzeugt und alles ist drin. Mein Problem ist nun, dass diese blöde Tabelle immer Zentriet in der E-Mail auftaucht. Ich möchte diese aber, wie der rest der E-Mail linksbündig haben.
Ich hoffe jemand kann mir helfen. Und wie gesagt, bitte nciht zerreissen, wenn diese Lösung schon irgendwo steht. Habe es einfach nciht gefunden.
Hier mein Makro:
Option Explicit
Public Sub SendMyMailNeu()
Dim Bereich As Range
Dim strGruß As String
Dim strBye As String
Dim strBetreff As String
Dim strEMail As String
Dim olApp As Object
Dim olMail As Object
Set Bereich = Application.Selection
' MsgBox Bereich.Address
' Betreff aus Zelle B2 beziehen
strBetreff = Range("B2").Value
' Adressenliste aus A2 beziehen
strEMail = Range("B1").Value
' Fester Text
strGruß = "Guten Morgen Sabine,"
' Fester Text
strBye = "Viele Grüße"
' E-Mail erstellen
Set olApp = GetObject(, "Outlook.Application")
Set olMail = olApp.createitem(0)
' Mail anzeigen
olMail.Display
' Adressverteiler einfügen
olMail.To = strEMail
' Signatur eintragen
olMail.GetInspector
' Betreffzeile einfügen
olMail.Subject = strBetreff
' Text
olMail.htmlBody = strGruß & " " & fncRangeToHtml("Rundmail", Bereich.Address) & " _
" & strBye & olMail.htmlBody
On Error GoTo 0
Set olMail = Nothing
End Sub
' Funktion damit die zu kopierende Tabelle eine Tabelle bleibt
Private Function fncRangeToHtml(strWorksheetname As String, strRangeaddress As String) As _
String
Dim objFilesytem As Object
Dim 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