Choisir pièce jointes pour mail

Bonjour,

Suite à ce sujet https://forum.excel-pratique.com/excel/envoyer-par-mail-une-plage-de-cellule-avec-un-corps-perso-172... , je voudrais pouvoir ajouter dans le code les lignes afin d'ouvrir l'explorateur de fichier et de sélectionner des pièces jointes en une fois (ctrl+clics ou maintien clic) puis de valider.

Merci.

Code en question.

Option Explicit

Const olMailItem As Integer = 0
Const olImportanceHigh = 2

Sub Envoi_Mail()
  Dim sDest As String, sCopie As String, Objet As String
  Dim Texte(2) As String
  Dim Cel As Range, Plage As Range
  Dim OutLk As Object, eMail As Object, Rng As Object, wdDoc As Object

  Objet = "blabla"
  Texte(1) = "Bonjour," & vbCr & vbCr & "Vous trouverez ci-dessous blabla"
  Texte(2) = "Vous souhaitant bonne réception"
  ' eMails du/des destinataires et copie
  sDest = "toto.machin@gmail.com"
  sCopie = "truc.bidule@gmail.com"
  '
  ' Création de l'instance Outlook et de l'objet email
  Set OutLk = CreateObject("outlook.application")
  Set eMail = OutLk.CreateItem(olMailItem)
  ' Plage à copier
  Set Plage = Sheets("Feuil1").Range("A2:C10")

  With eMail
    .Display  ' ICI pour afficher la signature et la conserver
    .To = sDest
    .CC = sCopie
    .Subject = Objet
    .Importance = olImportanceHigh
    ' Corps du mail
    Set wdDoc = eMail.GetInspector.WordEditor
    Set Rng = wdDoc.Range(0, 0)
    ' Insertion avant la copie du tableau
    Rng.InsertAfter Texte(1) & vbNewLine 'introduction
    '-------------------------------------------------------------------------
    'ajout du titre tableau 1
    Rng.InsertAfter vbNewLine         'titre tableau 1
    '-------------------------------------------------------------------------
    'ajout du tableau 1
    Set Rng = Rng.Paragraphs.Add().Range  'on ajoute un nouveau paragraphe
    Plage.Copy  ' Copie du tableau 1
    ' collage du tableau
    Rng.Paste:   Rng.Move 1, 1
    ' pied de page
    Rng.InsertAfter vbNewLine & Texte(2)
    '.Send     'Envoyer le message
  End With
  ' On efface les variables objets
  Set OutLk = Nothing: Set eMail = Nothing: Set wdDoc = Nothing
End Sub

Bonsoir Jeff143

Vous avez la possibilité d'utiliser une fonction pour ça

Function ChoixFichier(DefaultPath As String, sTitre As String, Optional sFilter As String)
  ' Le filtre doit être du type : "Fichier à joindre (*.xlsx), *.xlsx"
  Dim fd As FileDialog, TabFilter() As String
  ' Initialiser les variables
  If Right(DefaultPath, 1) <> "\" Then DefaultPath = DefaultPath & "\"
  ' Initialiser l'intance du dialogue
  Set fd = Application.FileDialog(msoFileDialogFilePicker)
  With fd
    .Filters.Clear
    ' Si un filtre a été donné
    If sFilter <> "" Then
      TabFilter = Split(sFilter, ",")
      .Filters.Add TabFilter(0), Trim(TabFilter(1))
    End If
    .Title = sTitre
    .InitialFileName = DefaultPath
    If .Show = -1 Then
      ChoixFichier = fd.SelectedItems(1)
    End If
  End With
  Set fd = Nothing
End Function

Intégré dans votre code, cela pourrait donner un truc comme ça

Option Explicit

Const olMailItem As Integer = 0
Const olImportanceHigh = 2

Sub Envoi_Mail()
  Dim sDest As String, sCopie As String, Objet As String
  Dim Texte(2) As String
  Dim Cel As Range, Plage As Range
  Dim OutLk As Object, eMail As Object, Rng As Object, wdDoc As Object
  Dim sPathFic as String

  Objet = "blabla"
  Texte(1) = "Bonjour," & vbCr & vbCr & "Vous trouverez ci-dessous blabla"
  Texte(2) = "Vous souhaitant bonne réception"
  ' eMails du/des destinataires et copie
  sDest = "toto.machin@gmail.com"
  sCopie = "truc.bidule@gmail.com"
  '
  ' Création de l'instance Outlook et de l'objet email
  Set OutLk = CreateObject("outlook.application")
  Set eMail = OutLk.CreateItem(olMailItem)
  ' Plage à copier
  Set Plage = Sheets("Feuil1").Range("A2:C10")

  With eMail
    .Display  ' ICI pour afficher la signature et la conserver
    .To = sDest
    .CC = sCopie
    .Subject = Objet
    .Importance = olImportanceHigh
    ' Corps du mail
    Set wdDoc = eMail.GetInspector.WordEditor
    Set Rng = wdDoc.Range(0, 0)
    ' Insertion avant la copie du tableau
    Rng.InsertAfter Texte(1) & vbNewLine 'introduction
    '-------------------------------------------------------------------------
    'ajout du titre tableau 1
    Rng.InsertAfter vbNewLine         'titre tableau 1
    '-------------------------------------------------------------------------
    'ajout du tableau 1
    Set Rng = Rng.Paragraphs.Add().Range  'on ajoute un nouveau paragraphe
    Plage.Copy  ' Copie du tableau 1
    ' collage du tableau
    Rng.Paste:   Rng.Move 1, 1
    ' pied de page
    Rng.InsertAfter vbNewLine & Texte(2)
    ' Choix du fichier par l'utilisateur
    sPathFic = ChoixFichier("C:\","CHOIX du FICHIER à JOINDRE","Fichier (*.xlsx), *.xlsx"
    .Attachments.Add sPathFic
    '.Send     'Envoyer le message
  End With
  ' On efface les variables objets
  Set OutLk = Nothing: Set eMail = Nothing: Set wdDoc = Nothing
End Sub

A+

D'accord merci bien. Etant donné que ce sont des fichiers pdf, je devrais mettre

Fichier (*.pdf), *.pdf