Sub E_Mail_Serienbrief()
 
  Dim Max_Emails As Integer
  Dim Max_Body As Integer
 
  Dim sAnrede As String
 
  '================================================
    Dim oOL As Object
    Dim oOLMsg As Object
    Dim oOLRecip As Object
    Dim oOLAttach As Object
    Dim iCounter As Integer
    Dim sFile As String, sRec As String, sSub As String
    Dim sBody As String
    Dim bln
 
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True
 
    bln = Application.DisplayStatusBar
 
    Set oOL = CreateObject("Outlook.application")  'Outlook Fenster öffnen
 
    For iCounter = 2 To Max_Emails + 2
        If Sheets("Adressbuch").Cells(iCounter, 3).Text = "" Then 'Stop wenn 
        ' alle E-Mails versand
            Exit For
        End If
        Select Case Sheets("Adressbuch").Cells(iCounter, 1).Text
            Case "Herr"
                sAnrede = "Sehr geehrter Herr " & Sheets("Adressbuch").Cells( _
                  iCounter, 2).Text & "," & vbCr
            Case "Frau"
                sAnrede = "Sehr geehrte Frau " & Sheets("Adressbuch").Cells( _
                  iCounter, 2).Text & "," & vbCr
        End Select
 
        sBody = sAnrede
 
        For jCounter = 10 To Max_Body
            sBody = sBody & Sheets("E-Mail").Cells(jCounter, 2).Text
        Next jCounter
 
        Application.StatusBar = "Sende E-Mail an " & sRec
 
        Set oOLMsg = oOL.CreateItem(0)
        With oOLMsg
            .To = sRec
            .Subject = sSub
            .Body = sBody
            .send
        End With
 
    Next iCounter
 
End Sub