EXCEL VBA Mail mit unterschiedlichen Anhängen versenden

Private Sub CommandButton1_Click()
    Dim wks As Worksheet
    Dim i As Integer
    Dim letzteZeile As Integer
    Dim dateiName As String
    Dim dateiPfad As String
    Dim olApp As Object
    Dim olOldbody As String
    Dim Files As String
    Dim fileGroups As Collection
    Dim fileGroup As Variant
    Dim fileAttachment As Variant

    Set wks = Worksheets("Tabelle1")  
    Set olApp = CreateObject("Outlook.Application")  

    letzteZeile = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
    dateiPfad = "C:\Users\daniel\Documents\test\"  

    ' Initialize a collection to store file groups  
    Set fileGroups = New Collection

    ' Loop through the rows to group files  
    For i = 1 To letzteZeile
        dateiName = wks.Range("A" & i).Value  

        ' Search for files that match the pattern: [dateiName][any character].pdf  
        Files = Dir(dateiPfad & dateiName & "?*.pdf")  

        Dim fileArray() As String
        Dim fileCount As Integer
        fileCount = 0

        Do While Files <> ""  
            ReDim Preserve fileArray(0 To fileCount)
            fileArray(fileCount) = Files
            fileCount = fileCount + 1
            Files = Dir
        Loop

        If fileCount > 0 Then
            fileGroups.Add Array(dateiName, fileArray)
        End If
    Next i

    ' Loop through the file groups and create emails  
    For Each fileGroup In fileGroups
        With olApp.CreateItem(0)
            .GetInspector.Display
            olOldbody = .htmlBody
            .To = "test@email.at"  
            .Subject = fileGroup(0) & ".pdf"  
            .htmlBody = "Hier kann Text rein oder nicht" & olOldbody  
            For Each fileAttachment In fileGroup(1)
                .Attachments.Add dateiPfad & fileAttachment
            Next fileAttachment
            .Display
        End With
    Next fileGroup
End Sub