Kopierten Bereich in Emailbody einfügen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Markus,
teste mal:

Option Explicit

Public Sub Test()

    Dim objOutlook As Object
    Dim objMail As Object
    Dim objWorksheet As Worksheet

    Set objWorksheet = Worksheets.Add

    Call Worksheets("Tabelle1").AutoFilter.Range.Copy(Destination:=objWorksheet.Cells(1, 1))

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With objMail
        .To = "xxxxxx@yyyyyyy.zz"
        .Subject = "Offene Reklamation "
        .HTMLBody = "ERSTEZEILEAUSTABELLE<br><br>" & RangeToHTML(objWorksheet, objWorksheet.UsedRange)
        .Display
    End With

    Application.DisplayAlerts = False
    Call objWorksheet.Delete
    Application.DisplayAlerts = True

    Set objWorksheet = Nothing
    Set objMail = Nothing
    Set objOutlook = Nothing
End Sub

Private Function RangeToHTML(ByRef probjSheet As Worksheet, ByRef probjRange As Range) As String

    Const ForReading As Long = 1
    Const TristateUseDefault As Long = -2

    Dim strFilename As String
    Dim objPublishObject As PublishObject
    Dim objFileSystemObject As Object
    Dim objFile As Object
    Dim objTextStream As Object

    strFilename = Environ$("TMP") & "/" & Format$(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"

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

    Set objFileSystemObject = CreateObject(Class:="Scripting.FileSystemObject")
    Set objFile = objFileSystemObject.GetFile(strFilename)
    Set objTextStream = objFile.OpenAsTextStream(ForReading, TristateUseDefault)

    RangeToHTML = objTextStream.ReadAll

    Call objTextStream.Close

    Call Kill(PathName:=strFilename)

    RangeToHTML = Replace$(RangeToHTML, "align=center", "align=left")

    Set objPublishObject = Nothing
    Set objTextStream = Nothing
    Set objFile = Nothing
    Set objFileSystemObject = Nothing
End Function

Gruß
Nepumuk

Hallo Markus,
teste mal so:

Option Explicit

Public Sub CreateMail()

    Dim objOutlook As Object, objMail As Object
    Dim objWord As Object

    Call Worksheets("Tabelle1").AutoFilter.Range.CopyPicture

    Set objOutlook = CreateObject(Class:="Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With objMail

        .BodyFormat = 2
        .To = "Empfänger@Porvider.de"
        .Subject = "Offene Reklamation "
        Call .Display
        Set objWord = .GetInspector.WordEditor.Application
        With objWord
            Call .Selection.TypeText(Text:="ERSTEZEILEAUSTABELLE")
            Call .Selection.TypeParagraph
            Call .Selection.TypeParagraph
            Call .Selection.Paste
            Call .Selection.TypeParagraph
            Call .Selection.TypeParagraph
            Call .Selection.TypeText(Text:="Gruß")
            Call .Selection.TypeParagraph
            Call .Selection.TypeText(Text:="Markus")
            Call .Selection.HomeKey(Unit:=6)

        End With
    End With

    Set objWord = Nothing
    Set objMail = Nothing
    Set objOutlook = Nothing
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Kopierten Bereich in Emailbody einfügen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kopierten Bereich in Emailbody einfügen

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread