AW: Tabellen-Bereich in E-Mail einfügen
01.06.2023 13:12:58
volti
Hallo Anna,
hier zwei mögliche Varianten. Da es eine HTML-Mail ist, kann man auch umfangreiche Formatierungen in HTML vornehmen, Falls da Bedarf besteht....
In Ermangelung Deiner Datei und Deiner lokalen Gegebenheiten konnte ich das nur begrenzt testen, denke aber, dass es funktionieren sollte.
Code:
Option Explicit
Sub Mail_erstellen1()
Dim sDatei As String
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2
.To = "anna-lena.loye@prima.de;" & Tabelle4.Range("T2").Value
.CC = Tabelle4.Range("T2").Value
.Subject = "Fakt. Volumen und HR per " & Tabelle4.Range("T4").Value
.Getinspector.Display
.htmlbody = _
"Hallo,<br><br>" _
& "anbei sende ich Ihnen die Umsatz- und Ertragszahlen per " & Tabelle4.Range("T4").Value _
& "; die Werte beziehen sich auf die ersten " & Tabelle1.Range("R24").Value & " von " _
& Tabelle1.Range("R23") & " Werktagen im " & "Mai.<br><br>" _
& "<u>Bitte beachten:</u> Sowohl der Bereich Wholesale (KD-Gr. 73 und 80) als auch der Bereich LNG (KD-Gr. 96/97/98) werden bei dieser Hochrechnung nicht berücksichtigt.<br>" _
& "<b>Fakt. Volumen ohne Bestandsveränderungen</b><br><br>" _
& "Der durschnittliche Einstandspreis über alle Kundengruppen beträgt " & Format(Tabelle2.Range("G2").Value, "####.#0") & " /t .<br>" _
& "Eingefüllt wurden bisher " & Format(Tabelle1.Range("E4").Value, "#,##0") & " t. Dies entspricht auf den Monat hochgerechnet " & Format(Tabelle1.Range("G4").Value, "#.#0%") & " des Plans.<br><br>" _
& Range2Html(Tabelle4.Range("A3:O4")) & "<br><br>" & .htmlbody
' Anlage dran
sDatei = "W:\BERICHTE\Fakt Volumen\2023\05-2023\HR Fakt. Vol. - ohne WS und LNG - per 26-05-2023.xlsx"
If Dir(sDatei) <> "" Then .Attachments.Add sDatei
End With
End Sub
Private Function Range2Html(oBereich As Range) As String
' Gibt den angegebenen Bereich als HTML zurück, incl.Bilder
Dim sTmpDatei As String, sTmp As String, sTmpVz As String
Dim iff As Integer, P As Long
' Bereich in Datei exportieren
With oBereich
sTmpVz = Environ$("temp") & "\"
sTmpDatei = sTmpVz & Format(Now, "ddmmyy" & Int(Timer) * 10) & ".htm"
.Parent.Parent.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=sTmpDatei, Sheet:=.Parent.Name, Source:=.Address, _
HtmlType:=xlHtmlStatic).Publish Create:=True
iff = FreeFile
Open sTmpDatei For Input As iff
Range2Html = Replace(Input(LOF(iff), iff), "align=center x:publishsource=", _
"align=left x:publishsource=")
Close iff
' Feststellen, ob auch Bilder im Bereich sind
P = InStr(1, Range2Html, "<link rel=File-List href=") + 26
If P > 26 Then
sTmp = Mid$(Range2Html, P, InStr(P, Range2Html, "/filelist.xml") - P)
Range2Html = Replace(Range2Html, sTmp, sTmpVz & sTmp)
End If
End With
On Error Resume Next
Kill sTmpDatei
Kill sTmpVz & sTmp
End Function
' ######################## ohne Range2HTML _
####################################
Sub Mail_erstellen2()
Dim sDatei As String, sMailtext As String, iEinf As Integer
With CreateObject("Outlook.Application").CreateItem(0)
.BodyFormat = 2
.To = "anna-lena.loye@prima.de;" & Tabelle4.Range("T2").Value
.CC = Tabelle4.Range("T2").Value
.Subject = "Fakt. Volumen und HR per " & Tabelle4.Range("T4").Value
.Getinspector.Display
sMailtext = "Hallo,¶¶" _
& "anbei sende ich Ihnen die Umsatz- und Ertragszahlen per " & Tabelle4.Range("T4").Value _
& "; die Werte beziehen sich auf die ersten " & Tabelle1.Range("R24").Value & " von " _
& Tabelle1.Range("R23") & " Werktagen im " & "Mai.¶¶" _
& "<u>Bitte beachten:</u> Sowohl der Bereich Wholesale (KD-Gr. 73 und 80) als auch der Bereich LNG (KD-Gr. 96/97/98) werden bei dieser Hochrechnung nicht berücksichtigt.¶" _
& "<b>Fakt. Volumen ohne Bestandsveränderungen</b>¶¶" _
& "Der durchschnittliche Einstandspreis über alle Kundengruppen beträgt " & Format(Tabelle2.Range("G2").Value, "####.#0") & " /t .<br>" _
& "Eingefüllt wurden bisher " & Format(Tabelle1.Range("E4").Value, "#,##0") & " t. Dies entspricht auf den Monat hochgerechnet " & Format(Tabelle1.Range("G4").Value, "#.#0%") & " des Plans."
iEinf = Len(sMailtext) - 22 ' Grafik Einfügestelle, ggf. mit Offset-Zahl spielen
.htmlbody = Replace(sMailtext, "¶", "<br>") & "<br>" & .htmlbody
Tabelle4.Range("A3:O4").Copy ' Bereich kopieren, ggf. Tabelle anpassen
With .Getinspector.WordEditor.Application.Selection
.Start = iEinf: .End = iEinf
.Paste ' Bereich in Mail einfügen
End With
' Anlage dran
sDatei = "W:\BERICHTE\Fakt Volumen\2023\05-2023\HR Fakt. Vol. - ohne WS und LNG - per 26-05-2023.xlsx"
If Dir(sDatei) <> "" Then .Attachments.Add sDatei
End With
End Sub
_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz