XL 2019 Pieces jointes mail

[tontonjoey]

Bonjour,
Je recherche comment envoyer plusieures pièces jointes avec un mail
Avec le code suivant j'arrive à en envoyer une, mais comment envoyer tous les fichiers xlsx du répertoire en cours????



Dt = ActiveWorkbook.Sheets("Feuil1").Range("B21")
corps = "Bonjour," _
& Chr(10) & "" _
& Chr(10) & "Veuillez trouver ci joint les états de présence du" & " " & Dt & "." _
& Chr(10) & "" _
& Chr(10) & "Cordialement" _
& Chr(10) & "" _
& Chr(10) & "L'Equipe RH" & Chr(10) & Chr(10)

sujet = "Etats de présence du" & " " & Dt

Set MonMessag = CreateObject("Outlook.Application")

Set Monenvoi = MonMessag.CreateItem(0)
With Monenvoi
.To = test@moi.fr
.Subject = sujet
.Body = corps
.Attachments.Add (tous les fichiers excel du répertoire en cours)
.Display

End With

 

[fanch55]

Bonsoir, à tester après avoir examiné l'adresse du Dossier

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