Sub
SendEmailWithExcelData()
Dim
OutlookApp
As
Object
Dim
OutlookMail
As
Object
Dim
ws
As
Worksheet
Dim
EmailBody
As
String
Dim
FilteredRow
As
Range
Dim
i
As
Integer
, j
As
Integer
Dim
olInspector
As
Object
Set
ws = ActiveSheet
On
Error
Resume
Next
Set
FilteredRow = ws.Range(
"A3:A"
& ws.Cells(ws.Rows.Count,
"A"
).
End
(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow
On
Error
GoTo
0
If
Not
FilteredRow
Is
Nothing
Then
If
FilteredRow.Count = 1
Then
EmailBody =
"<html><body><table border='1'>"
EmailBody = EmailBody &
"<tr><th>ws.Cells(2, 2).Value</th>"
For
i = 9
To
15
EmailBody = EmailBody &
"<th>"
& ws.Cells(2, i).Value &
"</th>"
Next
i
For
i = 35
To
51
EmailBody = EmailBody &
"<th>"
& ws.Cells(2, i).Value &
"</th>"
Next
i
EmailBody = EmailBody &
"</tr>"
EmailBody = EmailBody &
"<tr><td>"
& ws.Range(
"B2"
).Value &
"</td>"
For
i = 9
To
15
EmailBody = EmailBody &
"<td>"
& ws.Cells(FilteredRow.Row, i).Value &
"</td>"
Next
i
For
i = 35
To
51
EmailBody = EmailBody &
"<td>"
& ws.Cells(FilteredRow.Row, i).Value &
"</td>"
Next
i
EmailBody = EmailBody &
"</tr>"
EmailBody = EmailBody &
"</table></body></html>"
Set
OutlookApp = CreateObject(
"Outlook.Application"
)
If
OutlookApp.Inspectors.Count > 0
Then
For
Each
olInspector
In
OutlookApp.Inspectors
If
olInspector.CurrentItem.
Class
= olMail
Then
Set
OutlookMail = olInspector.CurrentItem
OutlookMail.HTMLBody = OutlookMail.HTMLBody &
"<br><br>"
& EmailBody
OutlookMail.Display
End
If
Next
olInspector
Else
MsgBox
"Es wurde keine geöffnete Mail gefunden."
, vbInformation
End
If
Else
MsgBox
"Es sind keine oder mehrere Zeilen gefiltert."
, vbExclamation
End
If
Else
MsgBox
"Keine gefilterte Zeile."
, vbExclamation
End
If
Set
FilteredRow =
Nothing
Set
ws =
Nothing
Set
OutlookMail =
Nothing
Set
OutlookApp =
Nothing
End
Sub