XL 2016 Excel - Ouvrir autant de mails Outlook que de Fichiers Excel

[Armandra]

Bonjour !

Alors voilà, j'ai décomposé un TCD en plusieurs onglets, puis créé un fichier excel par onglet dans un répertoire spécifié (ex : C:\\desktop\excel).

Maintenant, je souhaiterais que pour chaque fichier Excel présents dans ce répertoire, une macro (ou autre) m'ouvre un mail et joigne un fichier.

Pour faire simple, j'ai 90 fichiers .xls dans ce répertoire, et je souhaiterais que pour chacun d'entre eux, un mail soit ouvert avec le fichier joint.

J'ai écumé plusieurs forums et j'ai trouvé pour un fichier comment envoyer un mail mais je n'arrive pas à trouver pour plusieurs fichiers, un par mail.


Ex ci-dessus : J'ai 9 fichiers, je souhaiterais qu'un mail s'ouvre pour chacun d'entre eux avec le fichier joint (donc 9 mails).

J'espère avoir été clair, n'hésitez pas si vous avez des questions.

Sinon, si vous avez une solution plus facile afin d'arriver au même résultat, n'hésitez pas !!

Un grand merci par avance !

 

[fanch55]

Bonjour,
A tester:

Option Explicit
Sub Charge()
Dim Sh  As Worksheet

Set Sh = ActiveSheet
    On Error Resume Next: Sh.Shapes.Range(Array("Rapport")).Delete: On Error GoTo 0
    With Sh.OLEObjects.Add(ClassType:="Forms.Label.1", Left:=20, Top:=20, Width:=200, Height:=100)
        .Name = "Rapport"
        With .Object
            .BorderStyle = 1
            .WordWrap = False
            .AutoSize = True
            .BackColor = &HC0FFFF
            .Caption = "Liste des Fichiers à traiter" & vbLf
        End With
        
     ' La partie vraiment concernée par votre demande : -----------------------
        Dim Dossier     As String
        Dim Fichier     As String
        Dossier = ThisWorkbook.Path & "\"
        Fichier = Dir(Dossier & "*.xlsx")
        Do While Fichier <> ""
            Select Case True
                Case Fichier = ThisWorkbook.Name:   ' Le fichier est le même que celui-ci
                Case Else                           ' le fichier doit etre envoyé
                    .Object = .Object & vbLf & Envoi_Fichier(Fichier)
            End Select
            Fichier = Dir
         Loop
     ' -------------------------------------------------------------------------
        
        .Object = .Object & vbLf
    End With
Set Sh = Nothing

End Sub
Function Envoi_Fichier(Fichier As String) As String
' bla bla .... ma procédure pour outlook
    Envoi_Fichier = "Effectué: " & Fichier
End Function