XL 2010 Arborescence répertoires & répertoires vides + filtre fichiers

[SIre]

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,

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

 

[SIre]

Après réflexion, j'arrive à une solution de substitution en ajoutant

If Right(f.Name,3)="txt"

dans la boucle For Each f In dossier.Files.

Au final, je génère la liste que je cherchais, je vais pouvoir poursuivre