Bonjour à tous,
Après parcours du forum et autres, le code suivant (dont je ne suis pas l'auteur) répond à 99% à mon besoin puisqu'il me permet d'afficher les dossiers et dossiers vides..
L'objectif est de générer une liste de sous-répertoires pour s'assurer qu'un fichier y est bien présent.
Cependant je souhaiterais pouvoir filtrer sur les extensions de fichiers (exemple *.txt). J'ai ajouté un filtre pour définir l'extension avec la variable temp, mais à la compilation message d'erreur : Objet requis. Où est-ce que ma déclaration de variable pose-t-elle problème ?
Merci d'avance à ceux qui se pencheraient sur ce détail.
Sire,
Après parcours du forum et autres, le code suivant (dont je ne suis pas l'auteur) répond à 99% à mon besoin puisqu'il me permet d'afficher les dossiers et dossiers vides..
L'objectif est de générer une liste de sous-répertoires pour s'assurer qu'un fichier y est bien présent.
Cependant je souhaiterais pouvoir filtrer sur les extensions de fichiers (exemple *.txt). J'ai ajouté un filtre pour définir l'extension avec la variable temp, mais à la compilation message d'erreur : Objet requis. Où est-ce que ma déclaration de variable pose-t-elle problème ?
Merci d'avance à ceux qui se pencheraient sur ce détail.
Sire,
VB:
Dim ligne
Sub arborescence()
Dim fs As Object, myFile As Object, temp
Application.ScreenUpdating = False
racine = ChoixDossier()
If racine = "" Then Exit Sub
Range("A3:E20000").ClearContents
Range("A3").Select
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
ligne = 3
Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
Cells(ligne, 1) = String(4 * (niveau - 1), " ") & "[" & dossier.Path & "]"
Cells(ligne, 2) = dossier.Size
Cells(ligne, 4) = dossier.files.Count
Cells(ligne, 1).Interior.ColorIndex = 36
ligne = ligne + 1
For Each myFile In dossier.files
temp = fs.GetExtensionName(myFile.Name)
If (temp = "txt") Then
ActiveSheet.Hyperlinks.Add Anchor:=Cells(ligne, 1), _
Address:=dossier.Path & "\" & myFile.Name, TextToDisplay:=String(4 * niveau, " ") & myFile.Name
Cells(ligne, 1).Interior.ColorIndex = xlNone
Cells(ligne, 2) = myFile.Size
Cells(ligne, 3) = myFile.DateLastModified
Cells(ligne, 4) = myFile.Attributes
If myFile.Attributes And vbHidden Then Cells(ligne, 5) = "Caché"
ligne = ligne + 1
End If
Next
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
End Sub
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function