Zum Test machst du folgendes: Erstell eine neue Excel-Datei. Formatier die einzelnen Zellen im Bereich A1:B5 nach deinen Wünschen (Hintergrundfarbe, Rand usw). Einer oder mehreren der Zellen von C1:C5 gibst du einen grünen Hintergrund (damit meine ich das helle Grün in der Farbauswahl in der vierten Zeile von oben). Jetzt noch einen Button hinzufügen. Dann Extras -> Makro -> Visual Basic-Editor. Dort fügst du folgenden Code ein (und überschreibst bestehenden):
Sub Mail_Sheet_Outlook_Body(rng As Range)
Dim oOutApp As Object, oOutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set oOutApp = CreateObject("Outlook.Application")
oOutApp.Session.Logon
Set oOutMail = oOutApp.CreateItem(0)
On Error Resume Next
With oOutMail
.to = "name@host.de"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
'.Send ' E-Mail senden
.Display ' E-Mail in Outlook anzeigen (vorm Senden)
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set oOutMail = Nothing
Set oOutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim ofso As Object, ots As Object
Dim sTempFile As String
Dim wTemp As Workbook
sTempFile = 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 wTemp = Workbooks.Add(1)
With wTemp.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
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With wTemp.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=sTempFile, _
Sheet:=wTemp.Sheets(1).Name, _
Source:=wTemp.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set ofso = CreateObject("Scripting.FileSystemObject")
Set ots = ofso.GetFile(sTempFile).OpenAsTextStream(1, -2)
RangetoHTML = ots.ReadAll
ots.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
wTemp.Close savechanges:=False
Kill sTempFile
Set ots = Nothing
Set ofso = Nothing
Set wTemp = Nothing
End Function
Private Sub CommandButton1_Click()
Dim bSenden As Boolean
Dim i1 As Integer
For i1 = 1 To 5
If Cells(i1, 3).Interior.Color = RGB(256, 0, 0) Then ' Farbe Rot
bSenden = True
Cells(i1, 3).Interior.Color = RGB(0, 256, 0) ' Farbe Grün
Exit For
End If
Next i1
If bSenden Then Mail_Sheet_Outlook_Body Range("A1:B5")
End Sub
Betätigst du den Button, passiert
nichts. Warum? Die Spalte C hat höchstens eine Zelle mit grünem Hintergrund. Also mach rot draus (hellrot, dritte Zeile in Farbauswahl). Nochmal Button klicken. Jetzt müsste Outlook die Mail anzeigen.
Hat das alles funktioniert? Dann such im Quellcode nach
.Display, kommentier das aus und entkommentier das darüberliegende
.Send. Klappt hervorragend mit Excel 2003 und Outlook 2003.
