Séléction pièce jointe

Question

Je dois envoyer des documents tous les mois, à plusieurs personnes et pour se faire, j'ai crée un tableau. Le nom du fichier mensuel se compose ainsi : nom_personne + type + mois. Exemple : "MonsieurX hosp 12.22.xlsx" En me plaçant sur la cellule B58 (voir capture) de MonsieurX et en laçant mon code , il fait ce qu'il suit: - ouvre l'explorateur pour que je sélectionne le fichier de MonsieurX - ouvre le fichier sélectionné - récupère le montant dans le fichier - génère un email avec toutes les informations (l'email de Monsieur X et le montant à payer) Le code que j'utilise actuellement est ci-dessous. Ma question donc : Lorsque je clique sur le nom désiré, l'explorateur de fichier s'ouvre et me place dans le répertoire de la personne en question. Je dois manuellement sélectionner le fichier. Est-il possible de sauter cette étape, faire en sorte que le bon fichier se sélectionne automatiquement en sa basant sur sur son nom? Par exemple, je pourrais mettre dans la cellule C1 la date et le type que je traite : exemple "hosp 12.22.xlsx". De ce fait, le code pourrait se rendre dans le dossier en question et sélectionner automatiquement le fichier qui contient "*hosp 12.22.xlsx", sans que j'ai a le sélectionner à la main. Il faudrait procéder en se basant sur le nom de la cellule C1 (hosp 12.22.xlxs) car dans le dossier de MonsieurX, il y a un fichier par mois et d'autre type tel que "*gardes 12.22.xlsx", "*ambu12.22.xlsx". Il faut procéder ainsi car je ne dois pas tenir compte des autres fichiers, seulement ceux qui ont le mot "hosp" dans leur nom.Tous les mois je changerai la cellule C1 à la main en mettant le mois que je traite. J'espère que je me suis exprimé clairement. Je vous remercie d'avance pour votre aide. Sub envoi_hono_cab_divers() Dim outlookApp As Outlook.Application Dim adresse_mail As String Dim repertoire As String Dim myMail As Outlook.MailItem Dim Source_File As String Dim annee As String Dim periode As String Dim email As String Dim emailcopie As String Dim montant As String Worksheets("Cabinets_divers").Activate periode = Sheets("Cabinets_divers").Range("A2").Value date_paiement = Sheets("Cabinets_divers").Range("A1").Value repertoire = Selection.Offset(0, 4) email = Selection.Offset(0, 1) emailcopie = Selection.Offset(0, 2) 'Place l'utilisateur dans le bon répertoire ChDrive "W" ' &lt;&lt;&lt; lettre disque ChDir repertoire Source_File = Application.GetOpenFilename Workbooks.Open Source_File ' &lt;&lt;&lt;&lt; ajout pour ouvrir le fichier choisi Application.WindowState = xlMaximized 'Defiler jusqu'a la derniere ligne du fichier Sheets(1).Range("E" & Rows.Count).End(xlUp).Select montant = Sheets(1).Range("E" & Rows.Count).End(xlUp).Value 'Marquer une pause d'une seconde avant de passer à la suite. 'Sans la pause, le mail s'affiche alors que la PJ n'a pas eu le temps de se charger Application.Wait (Now + TimeValue("0:00:1")) Set outlookApp = New Outlook.Application Set myMail = outlookApp.CreateItem(olMailItem) myMail.To = email myMail.CC = emailcopie myMail.Subject = "Honoraires ambu " & periode myMail.HTMLBody = "Bonjour,&lt;br&gt; &lt;br&gt; Vous trouverez ci-joint la liste des honoraires a payer:&lt;br&gt;" _ & "&lt;br&gt;- Montant du paiement : " & montant & " CHF" _ & "&lt;br&gt;- Date d'exécution du paiement: " & date_paiement _ & "&lt;br&gt;- Période : " & periode _ & "&lt;br&gt;&lt;br&gt;Je vous invite a me contacter directement en cas d'interrogations quant à ce décompte." _ & "&lt;br&gt;&lt;br&gt; Monsieur xxxxxxxxxxx &lt;br&gt;Service Comptabilité" myMail.Attachments.Add Source_File myMail.Display True 'comment this out if you don't want to display email 'myMail.Send 'comment this out if you don't want to send yet 'Fermer le décompte après l'envoi du mail ActiveWindow.Close SaveChanges:=False End Sub...

Invité · Accepted Answer

D'après ce que j'ai compris, voici comment je ferais Sub Envoi_Hono_Cab_Divers() Dim OutApp As Object, eMail As Object Dim Wbk As Workbook Dim Repertoire As String Dim sFicSearch As String Dim SourceFile As String Dim sNomMed As String Dim sAnnee As String Dim sDatePaiement As String Dim sPeriode As String, sMois As String, sAnnée As String Dim sAdrMail As String Dim sAdrCopie As String Dim sMontant As String Dim LigSel As Long ' Mémoriser la ligne sélectionnée LigSel = Selection.Row With Worksheets("Cabinets_divers") sPeriode = .Range("A2").Value sMois = Left(sPeriode, 2): sAnnée = Right(sPeriode, 2) sDatePaiement = .Range("A1").Value sNomMed = .Range("B" & LigSel) Repertoire = .Range("F" & LigSel) sAdrMail = .Range("C" & LigSel) sAdrCopie = .Range("D" & LigSel) End With ' Nom du fichier à chercher ' Le nom du fichier mensuel se compose ainsi : nom_personne + type + mois. Exemple : "MonsieurX hosp 12.22.xlsx" sFicSearch = sNomMed & "*" & sMois & "." & sAnnée & "*.xlsx" SourceFile = Dir(Repertoire & sFicSearch) If SourceFile = "" Then MsgBox "Problème pour trouver : " & Repertoire & sFicSearch Exit Sub End If Set Wbk = Workbooks.Open(Repertoire & SourceFile) Application.WindowState = xlMinimized 'Defiler jusqu'a la derniere ligne du fichier sMontant = Sheets(1).Range("E" & Rows.Count).End(xlUp).Value ' Fermer le classeur Wbk.Close SaveChanges:=False ' Création d'une instance Outlook pour envoyer un mail Set OutApp = CreateObject("Outlook.Application") Set eMail = OutApp.CreateItem(0) With eMail .Display ' Permet d'afficher la signature .To = sAdrMail .CC = sAdrCopie .Subject = "Honoraires ambu " & sPeriode .HTMLBody = "Bonjour,&lt;br&gt; &lt;br&gt; Vous trouverez ci-joint la liste des honoraires a payer:&lt;br&gt;" _ & "&lt;br&gt;- Montant du paiement : " & sMontant & " CHF" _ & "&lt;br&gt;- Date d'exécution du paiement: " & sDatePaiement _ & "&lt;br&gt;- Période : " & sPeriode _ & "&lt;br&gt;&lt;br&gt;Je vous invite a me contacter directement en cas d'interrogations quant à ce décompte." _ & "&lt;br&gt;&lt;br&gt; Monsieur xxxxxxxxxxx &lt;br&gt;Service Comptabilité" & .HTMLBody ' Joindre la pièce jointe .Attachments.Add Repertoire & SourceFile End With End Sub A+...