Récupérer nom des fichiers présent dans un dossier ?
Bonjour,
Est-il possible, par macro, de pointer un dossier (bouton "...", ou "parcourir") comportant n fichiers, et que la MACRO affiche sur une feuille, ligne par ligne, le nom de chaque fichier présent dans le dossier ?
Colone An : Nom du fichier
Colone Bn : Extension du fichier
Merci davance,
Fab.
Bonjour,
Teste ce qui suit si ça convient. Lancer la proc "Test" en ayant au préalable adapté le chemin :
Sub Test()
Dim Tbl() As String
Dim I As Integer
Tbl = EnumFichiers("D:\")
'en colonne "A" et "B" de la feuille active si pas vide
If Not (Not Tbl) Then
For I = 1 To UBound(Tbl)
Cells(I, 1) = Tbl(I)
Cells(I, 2) = Right(Tbl(I), Len(Tbl(I)) - InStrRev(Tbl(I), "."))
Next I
End If
End Sub
Function EnumFichiers(Chemin As String) As String()
Dim TableauFichiers() As String
Dim Fichier As String
Dim I As Integer
'complète le chemin le cas échéant
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'récupère les fichiers
Fichier = Dir(Chemin)
'boucle sur les fichiers du dossier
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve TableauFichiers(1 To I)
TableauFichiers(I) = Fichier
Fichier = Dir()
Loop
'retourne le tableau des noms de fichiers
EnumFichiers = TableauFichiers()
End FunctionHervé.
Je préfèrerai un bouton "parcourir" pour changer le chemin. Si possible aussi, ne pas prendre en compte, dans le nom, l'extension du fichier.
C'est possible ?
Re,
Je pense que dans ton cas il serait plus commode d'ouvrir une boite de dialogue afin de sélectionner le dossier voulu. Pour le bouton, tu pose un bouton "Formulaire" sur ta feuille et tu affecte la macro "Recup" à ce bouton puis tu clique dessus pour voir si le résultat te convient :
Sub Recup()
Dim Tbl() As String
Dim I As Integer
Dim Chemin As String
Chemin = Dossier
Tbl = EnumFichiers(Chemin)
'en colonne "A" et "B" de la feuille active si pas vide
If Not (Not Tbl) Then
For I = 1 To UBound(Tbl)
Cells(I, 1) = Left(Tbl(I), InStrRev(Tbl(I), ".") - 1)
Cells(I, 2) = Right(Tbl(I), Len(Tbl(I)) - InStrRev(Tbl(I), "."))
Next I
End If
End Sub
Function EnumFichiers(Chemin As String) As String()
Dim TableauFichiers() As String
Dim Fichier As String
Dim I As Integer
'complète le chemin le cas échéant
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'récupère les fichiers
Fichier = Dir(Chemin)
'boucle sur les fichiers du dossier
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve TableauFichiers(1 To I)
TableauFichiers(I) = Fichier
Fichier = Dir()
Loop
'retourne le tableau des noms de fichiers
EnumFichiers = TableauFichiers()
End Function
Function Dossier() As Variant
'1 ouvrir un fichier
'2 enregistrement de fichier
'3 sélection de fichier
'4 sélection de dossier
With Application.FileDialog(4)
.Show
On Error Resume Next 'si annuler
Dossier = .SelectedItems(1)
If Err.Number <> 0 Then Dossier = False
End With
End FunctionHervé.
Super, ca fonctionne
Merci
Bonjour,
Une autre façon de faire ?
Avec éventuellement un lien HyperText
Sub LireFichier()
Dim Obj, RepP, Fich, TB, F
Dim Rep As String, i As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
On Error Resume Next 'si annuler
Rep = .SelectedItems(1)
If Err.Number <> 0 Then Exit Sub
End With
Rep = Rep & "\"
Set Obj = CreateObject("Scripting.FileSystemObject")
Set RepP = Obj.Getfolder(Rep)
Set Fich = RepP.Files
With ActiveSheet
i = 2 'première ligne où commencer
On Error Resume Next 'si pas d'extension
For Each F In Fich
TB = Split(F.Name, ".")
.Cells(i, "A") = TB(0)
.Cells(i, "B") = TB(1)
'Et éventuellement un lien HyperText pour appeler le fichier
.Hyperlinks.Add Anchor:=.Cells(i, "C"), Address:= _
Rep & F.Name, TextToDisplay:=TB(0)
i = i + 1
Next F
End With
Set Obj = Nothing
Set RepP = Nothing
Set Fich = Nothing
End SubA+
Bonjour,
J'ai utilisé la macro de récupération des fichiers et ça marche à merveille!
Sauf que j'ai un besoin particulier:
J'ai un répertoire dans lequel il y a plusieurs fichiers, chaque fichier est nommé d'une façon standard:
"Nom salle_type de données" (il y a 3 types de données)
mon fichier Excel est composé de 4 colonnes :
A=nom salle; B=Chemin fichier type de données1; C=Chemin fichier type de données2; D=Chemin fichier type de données3
Le but, est de pouvoir ouvrir un répertoire:
Récupérer les noms des salles (sans doublon) dans la colonne A
Récupérer le chemin du fichier type de données 1 dans la colonne B (s'il y en a) (Hypertexte)
Récupérer le chemin du fichier type de données 2 dans la colonne C (s'il y en a)(Hypertexte)
Récupérer le chemin du fichier type de données 3 dans la colonne D(s'il y en a)(Hypertexte)
Ci joint mon fichier avec la macro que j'ai un peu bricolé
Sub LireFichier()
Dim Obj, RepP, Fich, TB, F
Dim Rep As String, i As Integer, x As Integer
Range("a2:a200").ClearContents 'suuprimer les cellule remplies_____________
Range("b2:b200").ClearContents 'suuprimer les cellule remplies____________
Range("c2:c200").ClearContents 'suuprimer les cellule remplies___________
Range("d2:d200").ClearContents 'suuprimer les cellule remplies___________
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
On Error Resume Next 'si annuler
Rep = .SelectedItems(1)
If Err.Number <> 0 Then Exit Sub
End With
Rep = Rep & "\"
Set Obj = CreateObject("Scripting.FileSystemObject")
Set RepP = Obj.Getfolder(Rep)
Set Fich = RepP.Files
With ActiveSheet
i = 2 'première ligne où commencer
On Error Resume Next 'si pas d'extension
For Each F In Fich
TB = Split(F.Name, "_Liste")
.Cells(i, "f") = TB(0)
'Et éventuellement un lien HyperText pour appeler le fichier
.Hyperlinks.Add Anchor:=.Cells(i, "g"), Address:= _
Rep & F.Name, TextToDisplay:=Rep & F.Name
i = i + 1
Next F
'Placer les valeurs sans doublon dans la colonne a
Range("f2:f200").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("a2"), Unique:=True
End With
Set Obj = Nothing
Set RepP = Nothing
Set Fich = Nothing
End SubCi joint mon fichier avec la macro
Où qu'y est ??
Et u crois pas que ce serait plus simple...
Range("A2:D200").ClearContents 'suuprimer les cellule remplies_____________bonsoir,
Je sais que c a tirer par les cheuveux, je ne connais pas grand chose en matière de code vb.
Pouvez vous me venir en aide?
Merci pour votre intérêt.
Bonsoir ,
Ci après un autre essai, mais ça ne marche pas.
Ci joint le dossiers comportant un exemple.
Bonne soirée.
pourquoi compresser .
Met ton classeur en xls ou xlsm
Bonjour,
J'ai compressé le fichier xlsm ainsi que quelques fichiers comme exemple.
ci joint le fichier xlsm.
Bonne journée.
Tu a juste une erreur, le i = i + 1 doit être avant le next
Mais tu peu simplifier le code..
Sub LireFichier()
Dim Obj, RepP, Fich, TB, F
Dim Rep As String, i As Integer, x As Integer
Range("a2:g200").ClearContents 'suuprimer les cellule remplies_____________
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
On Error Resume Next 'si annuler
Rep = .SelectedItems(1)
If Err.Number <> 0 Then Exit Sub
End With
Rep = Rep & "\"
Set Obj = CreateObject("Scripting.FileSystemObject")
Set RepP = Obj.Getfolder(Rep)
Set Fich = RepP.Files
With ActiveSheet
i = 2 'première ligne où commencer
On Error Resume Next 'si pas d'extension
For Each F In Fich
If F.Name = .Cells(i, "a") & "_type de données1.xls" Then
.Hyperlinks.Add Anchor:=.Cells(i, "b"), Address:= _
Rep & F.Name, TextToDisplay:=Rep & F.Name
ElseIf F.Name = .Cells(i, "a") & "_type de données2.xls" Then
.Hyperlinks.Add Anchor:=.Cells(i, "c"), Address:= _
Rep & F.Name, TextToDisplay:=Rep & F.Name
ElseIf F.Name = .Cells(i, "a") & "_type de données3.xls" Then
.Hyperlinks.Add Anchor:=.Cells(i, "d"), Address:= _
Rep & F.Name, TextToDisplay:=Rep & F.Name
End If
i = i + 1
Next F
End With
Set Obj = Nothing
Set RepP = Nothing
Set Fich = Nothing
End SubA+
Re-bonjour;
J'ai essayé le code mais ça ne marche pas!!
ça marche pour un seul cas et ne copie que le premier chemin du fichier (pour ce cas il y a deux fichiers).
Ci joint le fichier avec le résultat.
Merci
Beh oui mais bondiou... explique clairement ce que tu veux, comme ça ont peut tourner en rond jusqu'a la St glinglin.
Salut,
Merci à toute et tous de vos efforts. Je retiens la formule de Banzaï64, fonction personnalisée, via module VBA.
Cela marche nickel même après incrémentation du nom de cellule SQL via gestionnaire de nom.
Et par curiosité, je vais aussi regarder toute les autres solutions proposées, et les adapter à mes nombreux supports Excel que je créé dans mon travail.
Encore merci.
Manu
veuillez considérer le message en bas
lermite a écrit :Beh oui mais bondiou... explique clairement ce que tu veux, comme ça ont peut tourner en rond jusqu'a la St glinglin.
La macro est supposée placer les chemins des fichiers selon les valeur des cellule de la colonne A.
par exemple dans le fichier que j'ai envoyé, je veux que chaque salle ait son/ces fichier(s) qui lui correspond(ent) placé dans les colonnes B, C ou D.
Le résultat final doit être comme suit:
salle Type1 Type2 Type3
| magMat | magMat_type de données1.xls | magMat_type de données2.xls | magMat_type de données3.xls
| magNour | magNour_type de données1.xls | | magNour_type de données3.xls
| magCim | magCim_type de données1.xls | magCim_type de données2.xls | magCim_type de données3.xls
| magBr | magBr_type de données1.xls | magBr_type de données2.xls |
| magFle | magFle_type de données1.xls | magFle_type de données2.xls |
| magBic | magBic_type de données1.xls | magBic_type de données2.xls | magBic_type de données3.xls
| magVoi | magVoi_type de données1.xls | | magVoi_type de données3.xls
Merci pour ta patience.
Bonjour Lermite;
Avez-vous examiner mon explication?
J'espère que c'est pas trop compliquée
Bonne journée
Salut,
Mon message précédent était pour un autre post, erreur d'éguillage.
Désolé.
Merci
@+
Manu
Salut,
Mon message précédent était pour un autre post, erreur d'éguillage.
Désolé.
Merci
@+
Manu
Re,
@ youcefe, remet tes exemples de fichiers mais pas en rar (j'ai pas le décompresseur Rar) poste le en Zip