Meerdere attachements in een email

[Ralf1991]

Beste helper,

Ik heb onderstaande code. Dit werkt alleen wordt alleen het laatste bestand in de range B2:B11 als attachment in de mail geplaatst.
De range B2:B11 bestaat uit onderstaande paths:
Voorbeeld:

X:\Departments\Data\Printshop.xlsx

Wat doe ik verkeerd?

Bedankt!

Sub send_mail()

Dim OutApp As Object
Dim rng As Range
Dim FileCell As Range

Set rng = Range("B2:B11")

Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .to = "ralf.pijpers@eu.chervongroup.com"  'CHANGE AS NECESSARY
        .Subject = "Test"   'CHANGE AS NECESSARY
        .Body = "Email body text"   'CHANGE AS NECESSARY
        
        For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell
                
        .Display
    End With

End Sub

 

[edmoor]

Werkt hier prima, dus loop je code eens in debug mode door om te kijken waarom hij maar 1x bij .Attachments.Add komt.