Sub ABC_verschicken()
Dim oOL As Object
Dim oOLMsg As Object
 
Dim oOLRecip As Object
Dim oOLAttach As Object
Dim iRow, Anzahl As Integer
Dim m_anzhl, iCounter As Integer
Dim Mails As Integer
Dim sFile, sRec As String, sSub As String
Dim sBody As String
Dim Warnung As Byte
Dim bln, S
   Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim strbody As String
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
 
'Dim OutApp As Outlook.Application
 
 
Mails = 0
 
 
Application.ScreenUpdating = False
iRow = Cells(Rows.Count, 3).End(xlUp).Row
'Hier wird in der Reihe B geschaut ob eine Rechnungsnummer vorhanden ist
 
Set oOL = CreateObject("Outlook.Application")
'Schauen wie viele Mails es werden
For m_anzhl = 3 To iRow
If Worksheets("Daten").Cells(m_anzhl, 32) = "" Then GoTo EFD Else
                'Hier wird geschaut, ob es in Verstrichene Tage was steht ( 
                ' Rechnungsalter).
    'If Cells(iCounter, 22) = "" Then Warnung = MsgBox("Rechnung fehlt." & vbLf 
    ' & "OK für überspringen", vbOKCancel, "Arbeit steht an") Else GoTo XX
    If Worksheets("Daten").Cells(m_anzhl, 33) = "Ja" Then GoTo ABC Else GoTo EFD
    'Hier schauen wir ob "Ja" drinnen steht also ob wir senden wollen
 
ABC:
Anzahl = Anzahl + 1
EFD:
Next m_anzhl
autosend = MsgBox("Möchtest du die Nachrichten vor dem Senden ansehen?" & _
  vbNewLine & "Es sind " & Anzahl & " Nachrichten", vbYesNoCancel)
If autosend = vbCancel Then Exit Sub
 
'Mit der For Schleife werden nun die Reihen durchgegangen
For iCounter = 3 To iRow
If Worksheets("Daten").Cells(iCounter, 32) = "" Then GoTo XXXXXX Else
                'Hier wird geschaut, ob es in Verstrichene Tage was steht ( 
                ' Rechnungsalter).
    'If Cells(iCounter, 21) = "" Then Warnung = MsgBox("Rechnung fehlt." & vbLf 
    ' & "OK für überspringen", vbOKCancel, "Arbeit steht an") Else GoTo XX
    If Worksheets("Daten").Cells(iCounter, 33) = "Ja" Then GoTo XYZ Else GoTo _
      XXXXXX
    'Hier schauen wir ob "Ja" drinnen steht also ob wir senden wollen
 
XYZ:
    If Dir(Worksheets("Daten").Cells(iCounter, 22)) = "" Then Warnung = MsgBox( _
      "Rechnung fehlt." & vbLf & "OK für überspringen" & vbLf & Cells(iCounter, _
      3) & "    " & Cells(iCounter, 10), vbOKCancel, "Arbeit steht an") Else _
      GoTo XX
    'Hier Schauen wir ob der Pfad zur Rechnung existiert. Wenn nicht dann gibts 
    ' Meldung.
            If Warnung = vbOK Then GoTo XXXXXX Else Exit Sub
                    'Bei 'OK' wird ein "Daten"satz übersprungen. Abbrechen 
                    ' brichts am Aktuellen ort ab, was da getan wurde wurde 
                    ' gemacht. Es gibt kein Rückgängig.
 
 
XX:
sFile = Worksheets("Daten").Cells(iCounter, 22) 'Anlage
    sRec = Worksheets("Text").Cells(iCounter, 3)  'An
 
    sSub = Worksheets("Text").Cells(iCounter, 9)  'Betreff
    sBody = Worksheets("Text").Cells(iCounter, 10) 'Text
    Worksheets("Daten").Cells(iCounter, 33) = Date 'Als gemahnt eintragen
'Worksheets("Daten").Cells(iCounter, 2).Style = "Schlecht"
'Worksheets("Daten").Cells(iCounter, 3).Style = "Schlecht"
'Worksheets("Daten").Cells(iCounter, 4).Style = "Schlecht"
'Worksheets("Daten").Cells(iCounter, 1).Style = "Schlecht"
 
    'Set oOLMsg = oOL.CreateItem(0)
    Set OutMail = oOL.CreateItem(0)
    With OutMail
'.SendUsingAccount = .Session.Accounts(2)
        .To = sRec
        .CC = ""
        .BCC = ""
        .Subject = sSub
        .Body = sBody
        '.Attachments.Add sFile
        .SendUsingAccount = OutApp.Session.Accounts.Item(2)
        .Attachments.Add sFile
        If autosend = vbYes Then .Display
        If autosend = vbNo Then .Send
        Mails = Mails + 1
    End With
 
   ' Set OutMail = Nothing
    'Set OutApp = Nothing
'oOLRecip.Resolve
XXXXXX:
Next iCounter
'Set oOL = Nothing
Warnung = MsgBox("Es wurden " & Mails & " Nachrichten verschickt.", vbOKOnly)
End Sub