Bestimmten Tabellenbereich per Mail mit Signature

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

.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

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

Beliebteste Forumthreads (12 Monate)

Bestimmten Tabellenbereich per Mail mit Signature

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bestimmten Tabellenbereich per Mail mit Signature

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

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread