Hallo zusammen,

ich bin nun an einem Punkt, andem ich mich im Kreis drehe :D

Ich möchte zur Automatisierung mehrere Screenshots im Mailbody einfügen.

Die letzten Tage habe ich bereits mehrere Möglichkeiten getestet aber es funktioniert einfach nicht mehrere Screenshots einzufügen.

Ein getesteter Bsp.-Code:

Sub Screenshots()

Dim wb As Workbook
Set wb = ThisWorkbook

Dim ws As Worksheet
Set ws = wb.Sheets("Overview Übersicht 7 Tage - (2)")

Dim rng As Range
Set rng = ws.Range("B3:T71")

Workbooks.Add

Dim CH As Chart
Set CH = Charts.Add

CH.Location xlLocationAsObject, "Tabelle1"
Set CH = ActiveChart
ActiveChart.Parent.Name = "rschwenk"
ActiveSheet.ChartObjects("rschwenk").Height = rng.Height
ActiveSheet.ChartObjects("rschwenk").Width = rng.Width

rng.CopyPicture xlScreen, xlBitmap
CH.Paste
CH.Export "C:\Users\rschwenk\Desktop\Ausbildung\Screenshot5.png"

Dim oApp As Object

Set oApp = CreateObject("Outlook.Application")

On Error Resume Next

    With oApp.CreateItem(0)
        Application.Wait 1
        .To = "rschwenk@united-internet.de"
        .Subject = "Betreff"
        .HTMLBody = "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot1.png'>" & "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot2.png'>" & "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot3.png'>" & "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot4.png'>" & "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot5.png'>"
        .Display
        SendKeys "{END}", True
        SendKeys "~", True
        SendKeys "^v", True
        SendKeys "~", True
        .GetInspector 'fügt die Standart-Signatur an
     End With

On Error GoTo 0
Set oApp = Nothing

End Sub


Die Lösung über "img src" würde ich nach Möglichkeit auch gerne mit einer Bitmap-Alternativ umgehen.

Vorab schon einmal vielen Dank für eure Unterstützung und beste Grüße