Bestimmten Tabellenbereich per Mail mit Signature

Heidi · 2019-01-25T06:15:16+00:00

Guten Morgen, ich bräuchte Hilfe. Wie kann ich in diesem Code einen bestimmten Tabellenbereich eingeben? Beispiel: A1:I90 ? Der Code funktioniert, aber leider erscheint mein fester Bereich nicht in der Mail. Code: Sub Mail_Outlook_With_Signature_Html_1() Dim OutApp As Object Dim OutMail As Object Dim strbody As String Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) strbody = " Dear Customer Ron de Bruin " & _ "Please visit this website to download the new version. " & _ "Let me know if you have problems. " & _ Thank you" On Error Resume Next With OutMail .Display .To = "max.muster@musterman" .CC = "" .BCC = "" .Subject = "This is the Subject line" .HTMLBody = strbody & " " & .HTMLBody .Send End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub Dankeschön!

Hallo Heidi,
teste mal:

Option Explicit

Public Sub Mail_Outlook_With_Signature_Html_1()

    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .Display
        .To = "max.muster@musterman"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .HTMLBody = RangeToHtml("Tabelle1", "A1:I90") & .HTMLBody 'Tabellenname und Bereich anpassen !!!
        .Send
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Private Function RangeToHtml( _
        ByVal pvstrWorksheetName As String, _
        ByVal pvstrRangeAddress As String) As String

    Dim objFilesytem As Object, objTextstream As Object
    Dim objPublishObject As PublishObject
    Dim strFilename As String, strTempText As String

    strFilename = Environ$("temp") & "\" & _
        Format(Now, "dd-mm-yy_hh-mm-ss") & ".htm"

    Set objPublishObject = ThisWorkbook.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        Filename:=strFilename, _
        Sheet:=pvstrWorksheetName, _
        Source:=pvstrRangeAddress, _
        HtmlType:=xlHtmlStatic)
    Call objPublishObject.Publish(Create:=True)

    Set objFilesytem = CreateObject("Scripting.FileSystemObject")
    Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)

    strTempText = objTextstream.ReadAll
    Call objTextstream.Close

    RangeToHtml = Replace(strTempText, "align=center x:publishsource=", _
        "align=left x:publishsource=")

    Set objPublishObject = Nothing
    Set objTextstream = Nothing
    Set objFilesytem = Nothing

    Call Kill(PathName:=strFilename)

End Function

Gruß
Nepumuk

Hallo du,
ich habe dir den Code nochmal geschickt, vielleicht fällt dir doch noch was auf, was falsch sein könnte, wenn nicht, dann lasse ich es erst Mal so.
Weißt du wie ich eine Zeile im Html-Body "kursiv" schreiben kann?
Option Explicit

Public Sub Mail_Outlook_With_Signature_Html_1()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = "heidi.martin@siemens.com;PLM;heidi.martin@siemens.com"
.CC = "heidi.martin@siemens.com"
.BCC = ""
.Subject = "Kick-off: 8Dxx-x - project name / country - LIPROGIS XXXX"
.HTMLBody = "Hallo, anbei erhalten Sie die aktuellen Projektunterlagen zum unten  _
genannten Projekt zum Zeitpunkt Kick-off (intern).

" & _
"Hello, enclosed you will find the current project documents for the project mentioned  _
below at the time of the kick-off (internal). 

" & _
RangeToHtml("Projektmail", "A1:I60") & .HTMLBody
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Private Function RangeToHtml( _
ByVal pvstrWorksheetName As String, _
ByVal pvstrRangeAddress As String) As String
Dim objFilesytem As Object, objTextstream As Object
Dim objPublishObject As PublishObject
Dim strFilename As String, strTempText As String
strFilename = Environ$("temp") & "\" & _
Format(Now, "dd-mm-yy_hh-mm-ss") & ".htm"
Set objPublishObject = ThisWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=pvstrWorksheetName, _
Source:=pvstrRangeAddress, _
HtmlType:=xlHtmlStatic)
Call objPublishObject.Publish(Create:=True)
Set objFilesytem = CreateObject("Scripting.FileSystemObject")
Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
strTempText = objTextstream.ReadAll
Call objTextstream.Close
RangeToHtml = Replace(strTempText, "align=center x:publishsource=", _
"align=left x:publishsource=")
Set objPublishObject = Nothing
Set objTextstream = Nothing
Set objFilesytem = Nothing
Call Kill(PathName:=strFilename)
End Function

1000 Dank

Bestimmten Tabellenbereich per Mail mit Signature

Forumthread: Bestimmten Tabellenbereich per Mail mit Signature

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Bestimmten Tabellenbereich per Mail mit Signature

Forumthread: Bestimmten Tabellenbereich per Mail mit Signature

31 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread