Creation dune liste de fichiers
Bonjour,
j'ai beaucoup lus , mais je n'ai pas trouvé le code qui me convient.
Je cherche a faire la liste de tout les fichiers (cahés ou non) d'un sous répertoire. et ceci pour tout les niveau de sous répertoire.
j'ai reussi a le faire au 1er niveau de sous rep en deux étapes (une pour les fichiers et une pour les sous rep
Sub Dossiers()
Dim Chemin As String, Fichier As String, Ligne As Integer, toto As Integer
toto = 3
Ligne = 4
Do While Chemin <> "fin"
Chemin = Range("A" & toto).Text
Fichier = Dir(Chemin & "\*.", vbDirectory)
Do While Fichier <> ""
If Fichier <> "." And Fichier <> ".." Then
Ligne = Ligne + 1
Cells(Ligne, 2) = Chemin & "\" & Fichier
End If
Fichier = Dir
Loop
toto = toto + 1
Loop
End Sub
Sub Fichiers2()
Dim Chemin As String, Fichier As String, Ligne As Integer, toto As Integer
Ligne = 4
toto = 3
Do While Fichier <> "fin"
Chemin = Range("A" & toto).Text
Fichier = Dir(Chemin & "\*", vbNormal)
Do While Fichier <> ""
If Fichier <> "." And Fichier <> ".." Then
Ligne = Ligne + 1
Cells(Ligne, 6) = Chemin & "\" & Fichier
End If
Fichier = Dir
Loop
toto = toto + 1
Loop
End Sub
mon besoin
1er colonne chemin
2eme colonne nom du fichier
3eme colonne extension
4eme colonne attibuts (cachés,.....)
si quelqu'un peu m'aider
cdlt
Ririgarett
J'utilise ceci réalisé en partie avec l'aide de ce forum, c'est suffisamment détaillé (en vert)
pour que tu puisses virer ce qui ne te va pas
Sub TestListeFichiers()
'Enlever tous les filtres
MsgBox "Merci de patienter (Longtemps!) pendant le tri"
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False
If .FilterMode Then .ShowAllData
End With
'Supprimer les lignes (modifier si besoin)
With ActiveSheet
Range("A7:G3000").Select
Selection.Clear
'Définit le répertoire pour débuter la recherche de fichiers.
Dim Dossier As String
'Le nom du dossier de recherche est renseigné en C4
Dossier = Range("C4")
'Affiche un message lorsque le tri est terminé
ListeFichiers Dossier
MsgBox "Liste " & Dossier & " mise à jour"
End With
End Sub
Sub ListeFichiers(Repertoire As String)
'
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Dans l'éditeur de macros (Alt+F11):
'Menu Outils
'Références
'Cochez la ligne "Microsoft Scripting RunTime".
'Cliquez sur le bouton OK pour valider.
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
'Récupère le numéro de la dernière ligne vide dans la colonne A.
i = Range("A3000").End(xlUp).Row + 1
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
'Indique le secteur
'Cells(i, 2).Value = Left(.Cells(i, 1), 4)
Cells(i, 1).FormulaR1C1 = "=LEFT(RC[3],3)"
'indique n° du document
Cells(i, 2).FormulaR1C1 = "=MID(RC[2],11,2)"
'Indique la date de dernier acces
Cells(i, 3) = FileItem.DateLastModified
Selection.NumberFormat = "dd/mm/yy"
'Inscrit le nom du fichier dans la cellule
Cells(i, 4) = FileItem.Name
'Ajoute un lien hypertexte vers le fichier
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 4), _
Address:=FileItem.ParentFolder & "\" & FileItem.Name
Cells(i, 5).FormulaR1C1 = "=MID(RC[-1],8,2)"
'indique type du document
Cells(i, 6).FormulaR1C1 = "=MID(RC[-2],5,2)"
'Nom du répertoire
Cells(i, 7).FormulaR1C1 = "= RIGHT(RC[-3],4)"
'incrémente le compteur
i = i + 1
Next FileItem
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
ListeFichiers SubFolder.Path
'End If
Next SubFolder
'Mettre en forme les cellules
Range("A8:G8", [A3000].End(xlUp)).Select
'Next SubFolder
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
End Sub