Schleife für Email-Anhänge

Hallo zusammen,

ich habe einen relativ einfachen Code zusammengeschrieben und -kopiert, um eine einfache Excel-Tabelle bestehend aus 4 Spalten und mehreren Zeilen zu durchlaufen und einzelne Mails per Outlook zu generieren. In den Spalten stehen die Namen von Projektmanagern (A), deren Emailadresse (B), ein zugehöriger Projektcode (C) und ein Marker (D), der "ja" oder "nein" sein kann, je nachdem ob eine Mail verschickt werden soll oder nicht. Das Makro durchläuft diese Liste und generiert eine Mail inkl. Anhang des jeweilig richtigen Projektberichts (Excelfile).
Nun ist es so, dass in der Liste teilweise Namen mehrfach vorkommen können mit verschiedenen Projekten. Mein Ziel wäre, dass aber pro Name nur eine Mail generiert wird und alle zugehörigen Anhänge in dieser einen Mail beigefügt werden.

Ich habe den Ansatz über einen Autofilter, der die jeweiligen Namen filtert und dann würde ich den gefilterten Bereich mit einer weiteren Schleife durchlaufen und die Anhänge entsprechend beifügen. Leider funktioniert diese zweite Schleife nicht richtig, d.h. es werden nicht mehrere Excelfiles beigefügt, sondern immer nur das erste aus der gefilterten Liste.

Hat jemand von euch vielleicht eine Idee, was falsch sein könnte oder wie es besser funktioniert?

Sub Test()

Dim wb As Workbook
Dim a As Range
Dim b As Range
Dim RangeArr As Range
Dim lastRow As Long
Dim iRows As Long
Dim objOutlook As Object
Dim objEmail As Object
Dim Ablage As DataObject
Dim AtchFile1 As String
Dim strOrdner As String


 Set wb = ThisWorkbook
 
' With Application.FileDialog(msoFileDialogFolderPicker)
'    .InitialFileName = Environ("UserProfile") & "\Desktop"
'    .Title = "Ordnerauswahl"
'    .ButtonName = "Auswahl"
'    .InitialView = msoFileDialogViewList
'
'    If .Show = -1 Then
'        strOrdner = .SelectedItems(1)
'        If Right(strOrdner, 1) > "\" Then strOrdner = strOrdner & "\"
'    Else
'        strOrdner = ""
'    End If
'End With
'    If strOrdner = "" Then
'        MsgBox ("No Folder selected!")
'    Exit Sub
'    End If
    
strOrdner = "C:\Beispielpfad\"
 
 With wb.Worksheets("Tabelle1").Range("C2").CurrentRegion
        For Each a In .Columns(1).Offset(1).Cells
            If a > "" Then
                For Each b In Range(.Columns(1).Cells(1), a.Offset(-1))
                    If b = a Then Exit For
                Next b
                If b Is Nothing Then
                    .AutoFilter Field:=1, Criteria1:=a
                   
            Set RangeArr = wb.Worksheets("Tabelle1").Range("A2:D65454").SpecialCells(xlCellTypeVisible)
            
            If RangeArr.Cells(1, 4).Value = LCase("yes") Then
        
                Set objOutlook = CreateObject("Outlook.Application")
                Set objEmail = objOutlook.CreateItem(olMailItem)
                
                Set Ablage = New DataObject
                
                wb.Worksheets("Tabelle2").Range("B3:B8").Copy
                
                With objEmail
                .To = RangeArr.Cells(1, 2)
            
                '.Subject = ws.Range("B1").Value & " | " & arrRange.Cells(intRow, 3).Value
                .Subject = "test"
                
               Ablage.GetFromClipboard
                .Body = Ablage.GetText(1)
               
                .Display
            
            For iRows = 2 To RangeArr.Rows.Count

                AtchFile1 = RangeArr.Cells(iRows, 3)

                .Attachments.Add strOrdner & Dir(strOrdner & "*" & AtchFile1 & "*xls*")

            Next iRows       
                End With
            
            Else
        End If
        
        Set objEmail = Nothing
        Set objOutlook = Nothing
               
                    End If
                    End If
                    Next a
        .AutoFilter Field:=1
    End With

   End Sub