Sub emailverschicken()
Dim Adressat As String
Dim cell As Range
Dim outapp As Object, outmail As Object
Dim Mailnachricht As String
Range("G5:G200").Select
Mailnachricht = "<span style=""font-size:10pt; font-family:'Arial'"">" & _
"Hallo zusammen,</br></br>anbei die wöchentliche IPMB-Liste aus unserer heutigen IPMB-Telko zu Ihrer Information."
Adressat = ""
For Each cell In Selection
If cell.Value Like "*@*" And cell.EntireRow.Hidden = False Then
Adressat = Adressat & ";" & cell.Value
End If
Next
Adressat = Mid(Adressat, 2)
Set outapp = CreateObject("Outlook.Application")
Set outmail = outapp.CreateItem(0)
With outmail
.Display
.GetInspector
.To = Adressat
.Subject = "IPMB-Liste vom " & Date
.HTMLBody = Mailnachricht & .HTMLBody
End With
Set outmail = Nothing
Set outapp = Nothing
End Sub