bis zur letzten beschriebenen Zeile
04.08.2020 08:47:36
Thomas
Ich nutze diesen Code, der auch das tut, was er soll.
Jetzt möchte ich, das der Bereich bis zur letzten beschriebenen Zeile versendet wird.
Leider fehlen mir die Kentnisse, wie ich diesen umschreiben muß.
Und, das er die Emailadresse aus dem Tabellenblatt "Bestellung" Zelle M3 nimmt.
Danke für Eure Hilfe
Gruß
Tommy
Option Explicit
Public Sub TableToMail()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.to = "nepumuk@himmel.aa"
.Subject = "Auslastung vom " & CStr(Date)
.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("A1:E12"))
.Display 'nur Anzeigen
' .Send 'direkt senden
End With
Set objMail = Nothing
Set objOutlook = Nothing
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
Anzeige