Sub Mailentwürfe_Mitglieder()
Application.ScreenUpdating = False
Dim Obj, Mail As Object
Dim letzteZeile As Integer, Zeile As Integer, SpalteName As Integer
Set Obj = CreateObject("Outlook.Application")
Set Mail = Obj.CreateItem(0)
letzteZeile = Range("Daten").Row + Range("Daten").Rows.Count - 1
SpalteName = Range("Daten_Kopf").Find("Name").Column
For Zeile = Range("Daten").Row To letzteZeile
Range("Auswahlfeld") = Worksheets("Eingabe").Cells(Zeile, SpalteName)
With Mail
.Subject = Range("Mail_Betreff")
.To = Range("Mail_An")
.cc = Range("Mail_cc")
End With
If Range("Mail_Versandart") = "Mail Standard" Then
Mail.Body = Range("Mail_Text_Standard")
Else
Mail.Body = Range("Mail_Text_weitere_Mitglieder")
End If
Mail.Display
Mail.Save
Mail.Close 0
Next Zeile
Set Obj = Nothing
Set Mail = Nothing
End Sub