Re : Récupérer le nom de fichiers
Bonjour,
Voici un peu plus de détails sur ce dont j'ai besoin : (je joint un fichier avec mon code)
Sub Copier_Fichiers_Dans_Dossier()
Dim Chemin As String
Chemin = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Dim Fichier
Fichier = Chemin & Application.PathSeparator & "BAA.xlsm" 'donner le nom exact du fichier pdf et du chemin où il sera stocké
ActiveWorkbook.SaveAs Filename:=Fichier, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
' Ouvrir les fichiers nécessaires
Workbooks.Open Filename:= _
"C:\Localisation certificats BAA.xlsx"
'Début
Windows("BAA.xlsm").Activate
Columns("D:E").Select
Selection.Insert Shift:=xlToRight
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[3],'[Localisation certificats BAA.xlsx]Localisation'!C1:C4,4,FALSE)"
Selection.AutoFill Destination:=Range("D2
" & Range("C65536").End(xlUp).Row)
Columns("D
").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
'-------------------------------------------------------------------------------------------------------------------------------------------------------
' ici je dois mettre le code qui me permettra de récupérer le nom complet de mes fichiers
'J'ai le chemin du fichier
'J'ai le début du nom du fichier qui correspond à mon numéro d'item
' Exemple du nom complet qui doit apparaître dans la colonne E : N47495, GHI 2014 (20%).pdf
' C'est le GHI 2014 (20%).pdf que je veux qui soiet extrait étant donnée que j'ai déjà N47495
'-------------------------------------------------------------------------------------------------------------------------------------------------------
Dim FSO As Object
Dim NomFich As String
Dim St As String
Dim Rep_Init As String, Rep_Fin As String
Dim Derlig As Integer
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Dossier = InputBox("Entrer le chemin du dossier, ne pas oublier de mettre \ à la fin")
Rep_Fin = Dossier
Sheets("Données").Select
Derlig = Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To Derlig
If Range("D" & i) <> "" Then
St = CStr(Range("D" & i))
Rep_Init = Replace(St, CStr(Range("E" & i)) & Right(St, 4), "")
NomFich = Range("E" & i)
On Error Resume Next
FSO.CopyFile Rep_Init & NomFich, Rep_Fin & NomFich, True
End If
Next i
Set FSO = Nothing
Windows("Localisation certificats BAA.xlsx").Activate
ActiveWindow.Close
Windows("BAA.xlsm").Activate
ActiveWindow.Close
Kill Fichier
End Sub
Merci
