Office: (Office 2013) Aus Excel per VBA ein Mail versanden inkl Screenshot

christian30031982 · 17. Dezember 2014

Hallo zusammen,

ich möchte gerne eine Mail inkl. Screenshot aus Excel heraus per VBA versenden.

Die Mail kann ich bereits senden:

Code:

Sub M()
Dim olApp As Object
Dim olOldBody As String

Set olApp = CreateObject("Outlook.Application")

With olApp.CreateItem(0)

'Set .SendUsingAccount =.Session.Accounts.Item ("Kontoname") ' Sendekonto vorwählen. Ab Outlook 2007 möglich
.GetInspector.Display

olOldBody = .htmlBody ' Body (Signatur) zwischenspeichern ***

'.To = Tabelle1.Cells(6, 2).Value

.Recipients.Add "abc@def.de" ' Empfänger ***

.Subject = "Probleme mit der auftragsdatei " ' Betreff ***

.htmlBody = "Bitte hier Ihre Nachricht eintragen
" & olOldBody ' Text und Signatur wieder eintragen ***
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Jetzt fehlt mir nur noch der Screenshot und das einfügen in die Mail.

Wenn in einer UserForm (während der Eingabe) ein Fehler auftritt, geht sofort das Fenster mit dem "falschen " Code auf geht ( wie ALT F11 ) ((warum auch immer. Besser wäre natürlich einen Anzeige mit der Fehlermeldung was falsch ist.))
Damit ich weiß, was der Nutzer falsch gemacht hat, möchte ich die Mail mit dem Screenshot haben, damit ich das korrigieren kann.

Danke

P.S.: Vielleicht wäre die Lösung mit der Fehlermeldung besser. Weiß aber leider nicht wie ich das einbauen kann. Dann würde der Nutzer direkt wissen was falsch ist und könnte seine falsche Eingabe korrigieren.

:)

Beverly · 18. Dezember 2014

Hi Christian,

als generellen Code zum Versenden einer Mail mit einen Tabellenbausschnitt kannst du diesen Code verwenden:

Code:

Sub MailSenden()
Dim objNachricht As Object
Dim objMail As Object
Dim rngBereich As Range
Set rngBereich = ActiveSheet.Range("B2:H18")
Set objMail = CreateObject("Outlook.Application")
Set objNachricht = objMail.CreateItem(0)
With objNachricht
.To = "Deine@Mailadresse"
.Subject = "Erinnerung"
.HtmlBody = "Sehr geehrte Damen und Herren," & vbLf & RangetoHTML(rngBereich)
.ReadReceiptRequested = False
.display
'.send
End With
Set objNachricht = Nothing
Set objMail = Nothing
Set rngBereich = Nothing
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
On Error Resume Next
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Set TempWB = Workbooks.Add(1)

'***********************
' ergänzt durch Beverly 11.02.13
' damit alle Formate - auch Zeilenhöhen - korrekt übertragen werden
Dim lngEnde As Long
Dim intEnde As Integer
Dim strSpalten As String
' Tabelle in die temporäre Arbeitsmappe kopieren
ThisWorkbook.Worksheets("Tabelle1").Copy before:=TempWB.Worksheets(1)
' bezogen auf die 1. Tabelle der temporären Arbeitsmappe
With TempWB.Worksheets(1)
' letzte Zeile des benutzten Bereichs
lngEnde = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
' letzte Spalte des benutzten Bereichs
intEnde = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
' Umwandeln Spaltennummern rechts in Spaltenbuchstaben
strSpalten = Left(.Cells(1, rng.Cells(1).Column + rng.Columns.Count).Address(True, False), _
InStr(.Cells(1, rng.Cells(1).Column + rng.Columns.Count).Address(True, False), "$") - 1) _
& ":" & Left(.Cells(1, intEnde).Address(True, False), _
InStr(.Cells(1, intEnde).Address(True, False), "$") - 1)
' Zeilen unterhalb löschen
.Rows(rng.Cells(1).Row + rng.Rows.Count & ":" & lngEnde).Delete
' Spalten rechts löschen
.Columns(strSpalten).Delete
' wenn nicht Zeile 1 dann Zeilen oberhalb löschen
If rng.Cells(1).Row > 1 Then .Rows("1:" & rng.Cells(1).Row - 1).Delete
' wenn nicht Spalte 1 dann Spalten links löschen
If rng.Cells(1).Column > 1 Then
' Umwandeln Spaltennummern rechts in Spaltenbuchstaben
strSpalten = "A:" & Left(rng.Cells(1).Offset(0, -1).Address(True, False), InStr(rng.Cells(1).Offset(0, -1).Address(True, False), "$") - 1)
' Spalten links löschen
.Columns(strSpalten).Delete
End If
End With
TempWB.Save
'***********************

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

christian30031982 · 18. Dezember 2014

Hallo Beverly,

danke für deinen Code.

Leider hilft mir der Code nicht so recht. Ich brauche einen Screenshot, weil ja der VBA Editor geöffnet wird und dort der Fehler markiert wird.

Hättest du dafür auch eine Lösung?

Danke

Beverly · 18. Dezember 2014

Hi Christian,

sorry, dann hatte ich dich falsch verstanden.

Weshalb schreibst du deinen Code im UserForm nicht so, dass Fehler gleich abgefangen werden und eine von dir gewünschte Fehlermeldung ausgegeben wird, ohne dass sich der VBA-Editor öffnet?
Ohne allerdings die Mappe, den Code und die auftretenden Fehler (bzw. unter wlechen Bedingungen sie auftreten) zu kennen, kann man da aber leider nicht viel sagen, wie es sich vielleicht besser lösen lässt.

christian30031982 · 18. Dezember 2014

Hallo Beverly,

danke für den Rat.

Leider weiß ich nicht wie ich den Code am einfachsten posten soll damit er auch funktioniert.

Ich könnte dir die Datei an deine Mailadresse schicken.

Danke

Beverly · 18. Dezember 2014

Hi Christian,

erstelle doch einfach eine Kopie deiner Mappe, die du hier hochladen kannst und belasse dabei nur ein paar von den Daten (eventuell anonymisieren), die für das Problem relevant sind.

Office: (Office 2013) Aus Excel per VBA ein Mail versanden inkl Screenshot

Aus Excel per VBA ein Mail versanden inkl Screenshot

Aus Excel per VBA ein Mail versanden inkl Screenshot

Aus Excel per VBA ein Mail versanden inkl Screenshot

Aus Excel per VBA ein Mail versanden inkl Screenshot - Similar Threads - Excel VBA Mail

VBA eine Mail Empfänger aus Zellen ziehen

VBA Grafik in E-Mail einfügen

Versenden E-Mail aus Excel Liste via VBA & Outlook

Aufgaben aus einer Excel-Tabelle an verschiedene E-Mail-Adressen verteilen

VBA Excel zweite Mail-Adresse hinzufügen

Excel VBA: Outlook öffnen, Mail senden und schließen

Excel Mail versenden