Office: Excel 2003 (VBA) Tabellenblatt Bereich als Email senden

Robsterboy · 8. Februar 2013

Hallo zusammen,
ich bin neu in eurer Runde und möchte nach vergeblicher Suche Rat erfragen. Von VBA habe ich wenig Ahnung und konnte bis jetzt einen "gefundenen" VBA-Code dazu nutzen, Excel-Dateien als Email-Anhang zu versenden.

Nun würde ich gerne einen Bereich des Tabellenblatts (A1:G17) anstelle des Email-Anhangs in die Email in Outlook einfügen. Email ist HTML basiert.

Ich würde mich freuen, wenn jmd meinen VBA-Code entsprechend anpassen würde und kurz erklärt, was welchen Zweck hat. Vielen Dank.

Code:

Sub Excel_Workbook_via_Outlook_Senden_Click()
Dim MyMessage As Object, MyOutApp As Object
Dim Qe As Integer
Dim AWS As String
'Testen ob die aktuelle Mappe schon gespeichert wurde
If ThisWorkbook.Saved = False Then
'Die letzten Änderungen wurden noch nicht gespeichert
Qe = MsgBox("Diese Mappe wurde noch nicht gespeichert, und kann nicht versandt werden!" _
& Chr$(13) & "Soll die Datei gespeichert werden?", vbInformation + vbYesNo, "Sendefehler")
If Qe = vbNo Then
'Abbruch durch Benutzer
MsgBox "Sendevorgang abgebrochen"
Exit Sub
Else
'Prüfen ob die Datei schon mal gespeichert wurde
If Right(ThisWorkbook.Name, 3) "xls" Then
'Nein > Speicherdialog aufrufen
Application.Dialogs(xlDialogSaveAs).Show
Else
'Speichern
ThisWorkbook.Save
End If
End If
End If
'Aktive Arbeitsmappe wird als mail gesendet
'Übergabe des Mappennames an die Variable
AWS = ThisWorkbook.FullName
'Outlook Object erstellen
Set MyOutApp = CreateObject("Outlook.Application")
'Outlook Nachricht erstellen
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Empfänger
.To = "Mustermann, Max"
.BCC = "Mustermann, Petra"
'Betreff
.Subject = ThisWorkbook.Name '& Date & Time

.Attachments.Add AWS
.GetInspector ' sorgt für die Signatur
'Hier wird ein normaler Text erstellt
'.Body = "Das ist ein Test." & vbLf & vbLf
'Hier wird eine HTML Mail erstellt
'Dies kann zu Problemen führen, wenn der Empfänger
'nur TEXT Dateien empfangen darf.
'.HTMLBody = "Das ist ein Test." & vbCrLf & "Bitte ignorieren."
'Hier wird die Mail nochmals angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt und gesendet
'.Send
End With
'Outlook schliessen
'MyOutApp.Quit
'Variablen leeren
Set MyOutApp = Nothing
Set MyMessage = Nothing
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruß
Robsterboy

:)

Beverly · 9. Februar 2013

Hi,

Code:

Sub MailSenden()
Dim objNachricht As Object
Dim objMail As Object
Dim rngBereich As Range
Set rngBereich = ActiveSheet.Range("A1:G17")
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"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
' .DrawingObjects.Visible = True
'.DrawingObjects.Delete
On Error GoTo 0
End With

'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.

Robsterboy · 10. Februar 2013

Hallo Beverley,
vielen Dank für diesen Code. Ich tüftele allerdings jetzt eine Weile daran herum, dass in das temporäre html Objekt nicht die Formatierung der Zellen, bzw. nicht die Zeilenhöhe und die Spaltenbreite übernommen werden.
Das ganze wird dann zwar richtig in die Mail eingebettet, sieht aber bescheiden aus. Was ich einfach suche, ist ein einbetten wie es die Funktion "Datei -> Senden an -> Email Empfänger ..." macht. Da bleibt dann die Optik erhalten.

Warum ich das machen will ist einfach, dass ich viele verschiedene Excel Blätter in Emails an viele verschiedene Empfänger sehr oft versenden muss.

Grüße
Robsterboy

Beverly · 10. Februar 2013

Hi,

dein Problem kann ich leider nicht nachvollziehen - bei mir wird mit diesem Code die Tabellenformatierung 1:1 und in hervorragender optischer Qualität in die Mail übertragen. Im Anhang ein Bild der Mail-Ansicht Ansicht.

Robsterboy · 11. Februar 2013

Komisch bei mir, irgendwie macht er alle Zellen in der Email dann auch gleich groß, so wie einem neuen Excel sheet.
Kannst du die Zellen deiner versendeten Excel Seite nach empfang der Email noch editieren wenn die sie beantwortest? Das geht bei mir - soll auch so sein - bei dir sehe ich einen Rahmen um den Excel Ausschnitt, wie bei einem Bild?

Grüße
Robsterboy

edit: Ich verweise noch mal auf meine Absicht, das ganze in Excel 2003 zu machen.

Beverly · 11. Februar 2013

der Rahmen den du auf dem Bild siehst, ist der Rahmen der in HTML-Text transformierten Exceltabelle - folglich lässt sie sich auch noch bearbeiten und ist kein Bild.

Ich habe im Originalcode von Ron de Bruin für das Umwandeln in HTML-Text einiges geändert (die Zeilen in **** hinzugefügt und einige Zeilen auskommentiert) - jetzt wird die zu versendende Tabelle als solche in die temporäre Excelarbeitsmappe kopiert (Tabellenname musst du anpassen!), also tatsächlich 1:1 mit allen Formatierungen. Im Originalcode wird dies ja anders gemacht: der Tabelleninhalt/Format per Copy & Paste übertragen - vielleicht ist das ja die Ursache, dass es in Office2003 nicht so wie gewünscht funktioniert, da die Formatierung der Zeilenhöhe dabei nicht mit übertragen wird.

Code:

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)

'***********************
Dim lngEnde As Long
Dim intEnde As Integer
Dim strSpalten As String
ThisWorkbook.Worksheets("Tabelle1").Copy before:=TempWB.Worksheets(1)
With TempWB.Worksheets(1)
lngEnde = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
intEnde = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
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)
.Rows(rng.Cells(1).Row + rng.Rows.Count & ":" & lngEnde).Delete
.Columns(strSpalten).Delete
End With
TempWB.Save
'***********************

' With TempWB.Sheets(1)
' .Cells(1).PasteSpecial Paste:=8
' .Cells(1).PasteSpecial xlPasteValues, , False, False
' .Cells(1).PasteSpecial xlPasteFormats, , False, False
' .Cells(1).Select
' Application.CutCopyMode = False
' ' .DrawingObjects.Visible = True
' '.DrawingObjects.Delete
' On Error GoTo 0
' End With

'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.

In Office2003 kann ich es leider nicht testen, da ich zwar Excel2003 aber nicht Outlook2003 besitze.

Robsterboy · 11. Februar 2013

Danke, Beverly. Ja so funktioniert es wie ich es mir vorgestellt hatte ... fast.

Gehe ich den zuletzt von dir vorgegebenen Weg über das temporäre Sheet, dann verliert er die Zellenbezüge. Passiert nicht, wenn ich über das temporäre HTML oder über "senden" in Excel selbst gehe.

Was muss ich in VBA ergänzen, damit er anstelle der Verknüpfungen die Formatierung, die Rahmen und die Zelleninhalte übernimmt? Weil selbst händisch ist das ja oft ein Akt.

Danke und Gruß
Robsterboy

Beverly · 11. Februar 2013

in keinem deiner Beiträge stand, dass es sich im Bereich A1:G17 um Formeln handelt.

Ergänze den Code nach der Zeile With TempWB.Worksheets(1) um diese beiden Zeilen:

Code:

.Cells.Copy
.Range("A1").PasteSpecial Paste:=xlValues
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Excel 2003 (VBA) Tabellenblatt Bereich als Email senden

Excel 2003 (VBA) Tabellenblatt Bereich als Email senden

Excel 2003 (VBA) Tabellenblatt Bereich als Email senden

Excel 2003 (VBA) Tabellenblatt Bereich als Email senden

Excel 2003 (VBA) Tabellenblatt Bereich als Email senden

Excel 2003 (VBA) Tabellenblatt Bereich als Email senden - Similar Threads - Excel 2003 VBA

fortlaufendes Datum in 12 Arbeitsblättern Januar-Dezember Excel 2003 ohne VBA

Office 2003 / Accesstabellen und Abfragen von Excel per VBA starten...

[EXCEL 2003] - VBA - Automatisiert Bilder einfürgen ber VBA

dynamisches Diagramm - VBA Frage - Excel 2003

VBA Excel 2003 ( Makros) Programierung

Excel 2003 Kopieren mehrerer Zellen mit VBA

Excel VBA von 2003 in 2007