XL 2019 Pieces jointes mail

Sub Test()
Dim Fichier As String, Dossier As String

    Dt = ActiveWorkbook.Sheets("Feuil1").Range("B21")
    corps = "Bonjour," _
        & vbLf & "" _
        & vbLf & "Veuillez trouver ci joint les états de présence du" & " " & Dt & "." _
        & vbLf & "" _
        & vbLf & "Cordialement" _
        & vbLf & "" _
        & vbLf & "L'Equipe RH" & vbLf & vbLf
    
    sujet = "Etats de présence du" & " " & Dt
    
    With CreateObject("Outlook.Application").createitem(0)
        .To = "test@moi.fr"
        .Subject = sujet
        .Body = corps
            
        Dossier = ThisWorkbook.Path & "\"
    
    ' Si dossier toujours identique, commnenter le bloc ci-dessous
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = Dossier
            If .Show = -1 _
            Then Dossier = .SelectedItems(1) & "\" _
            Else Dossier = vbNullString
        End With
     ' fin bloc
        
        If Dossier <> vbNullString Then
            Fichier = Dir(Dossier & "*.xls")
            Do While Fichier <> ""
                .Attachments.Add Dossier & Fichier
                Fichier = Dir
            Loop
            .Display
        End If
    End With
    
End Sub