Code VBA lister dossier / sous dossier / fichier etc... Problème

Eljojo_e · 22 Septembre 2015

Bonjour,

J'ai trouvé un bout de code qui permet de lister dossier + sous dossier etc... d'un répertoire.

J'ai rajouté une partie qui permet de lister les fichiers présents. (sur un excel pour le moment)

Le code fonctionne mais la liste est complétement désordonné.

J'aurais aimé que ca liste tout dans l'ordre alphabétique sans filtrer par la suite. (J'aimerais appliquer ça à un treeview sur access qui n'est pas triable)

Merci d'avance !

Code:

Sub TousLesDossiers(LeDossier$, Idx As Long)
    Dim strDossier As String
    Dim strFichier As String
    Dim FSO As Object, Dossier As Object
    Dim sousRep As Object, Flder As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(LeDossier)
    
    'examen du dossier courant
    For Each Flder In Dossier.SubFolders
        Idx = Idx + 1
        Cells(Idx, 1).Value = Flder.Path & "\"
        'Rajou de fichier #début
          ' Lister tous les fichiers du dossier
        strFichier = Dir(Flder.Path & "\", vbNormal)
        While strFichier <> ""
            ' Afficher le nom du fichier
            Idx = Idx + 1
            Cells(Idx, 1).Value = Flder.Path & "\" & strFichier
            'Lire le fichier suivant
            strFichier = Dir
        Wend
        'rajout de fichier #fin
    Next
    'traitement récursif des sous dossiers
    For Each sousRep In Dossier.SubFolders
        TousLesDossiers sousRep.Path, Idx
    Next sousRep
    Set FSO = Nothing
End Sub

Et son lanceur

Code:

Sub Tout_Lister()
  TousLesDossiers "Y:\TRAVAUX\2015 test", 0
End Sub

Paf · 22 Septembre 2015

Re : Code VBA lister dossier / sous dossier / fichier etc... Problème

Bonjour,

peut-être, plutôt que de copier au fur et à mesure dans la feuille, copier au fur et à mesure dans un tableau, puis en fin de sub trier le tableau et enfin copier le tableau trié sur la feuille ?

A+

Eljojo_e · 22 Septembre 2015

Re : Code VBA lister dossier / sous dossier / fichier etc... Problème

Paf à dit:
Bonjour,

peut-être, plutôt que de copier au fur et à mesure dans la feuille, copier au fur et à mesure dans un tableau, puis en fin de sub trier le tableau et enfin copier le tableau trié sur la feuille ?

A+

Bonjour et merci de ta réponse rapide.

A vrai dire, si j'ai bien compris, il faut créer un "tableau en vba" le trier et le collé sur une feuille ? (je sais pas faire de tableau en vba je vais me renseigner la dessus ou j'ai mal compris..)

Eljojo_e · 24 Septembre 2015

Re : Code VBA lister dossier / sous dossier / fichier etc... Problème

Du coup je me suis débrouillé autrement.
Si ça intéresse quelqu'un :

Code:

Sub arborescence()
'Activer la référence Microsoft Scripting Runtime !!!!!!

'###############################gestion icone treeview début

DoCmd.Hourglass True
TreeView0.Nodes.Clear
'Supprime toutes les images de la liste
Me.ImageList1.ListImages.Clear

'Définit la dimension des images
Me.ImageList1.ImageHeight = 18 'Hauteur
Me.ImageList1.ImageWidth = 18 'Largeur

'Charge les images
Img1 = "Z:\07 - Gestion informatique\01 - Bases de données\00 - SOURCE DES DONNEES\02 - IMAGES\01 - ICONES\Icône Dossier.jpg"
Img2 = "Z:\07 - Gestion informatique\01 - Bases de données\00 - SOURCE DES DONNEES\02 - IMAGES\01 - ICONES\Icône PacMan.jpg"
Img3 = "Z:\07 - Gestion informatique\01 - Bases de données\00 - SOURCE DES DONNEES\02 - IMAGES\01 - ICONES\Icône Fichier Standard.jpg"

'Nécessite d'ajouter un controle imagelist n'importe où dans le formulaire
Me.ImageList1.ListImages.Add , "Image1", LoadPicture(Img1)
Me.ImageList1.ListImages.Add , "Image2", LoadPicture(Img2)
Me.ImageList1.ListImages.Add , "Image3", LoadPicture(Img3)

'Associe les images au TreeView
Set TreeView0.ImageList = Me.ImageList1.Object

'###############################gestion icone treeview fin

racine = "D:\TEST" 'ChoixDossier() ' ou un répertoire C:\xxx e.g.
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.GetFolder(racine)
num = 1000000000 '<- ce nombre est là pour éviter de faire des doublons sur les nodes correspondant aux fichiers (et pas dossier) présent sur le treeview. Si il est pas, il y aurait doublons de clé
Set nodx = TreeView0.Nodes.Add(, , "A", "Titre au choix !", "Image2") ', "Image1")
Lit_dossier2 dossier_racine, 1, num ' c'est partie, on liste les nodes
DoCmd.Hourglass False

Set Img1 = Nothing
Set Img2 = Nothing
Set Img3 = Nothing
Set nodx = Nothing
Set fs = Nothing
Set dossier_racine = Nothing
Set num = Nothing
Set niveau = Nothing
Set dossier = Nothing
End Sub

Code:

Sub Lit_dossier2(ByRef dossier, ByVal niveau, ByRef num)
    If niveau = 1 Then
        Set nodx = TreeView0.Nodes.Add("A", tvwChild, dossier.Path, dossier.Name, "Image1") ' gestion des dossiers de 1er niveau de node
    Else
        Set nodx = TreeView0.Nodes.Add(Left(dossier.Path, Len(dossier.Path) - Len(dossier.Name) - 1), tvwChild, dossier.Path, dossier.Name, "Image1") ' gestion des dossiers de niveau > 1 de node
    End If
    
    For Each f In dossier.Files
        If niveau = 1 Then
            Set nodx = TreeView0.Nodes.Add("A", tvwChild, f.Name, f.Name, "Image3") ' gestion des fichiers de 1er niveau de node
        Else
            If f.Name = "Thumbs.db" Then GoTo a:
            Set nodx = TreeView0.Nodes.Add(Left(dossier.Path, Len(dossier.Path)), tvwChild, dossier.Path & num, f.Name, "Image3") ' gestion des fichiers de niveau > 1 de node
            num = num + 1 ' ce fameux num qui est là pour eviter les doublons de clé. On peut ajouter jusqu'à 9 999 999 999 de nodes de fichiers différents ... Ca sera assez !
a:
        End If
    Next
    For Each D In dossier.SubFolders
       Lit_dossier2 D, niveau + 1, num
    Next
End Sub

Code:

Public Sub treeview0_dblclick()
    If Left(Right(TreeView0.SelectedItem.Text, 4), 1) <> "." Then ' il un fichier est détecté, il l'ouvre avec l'application défini dans windows. Si c'est un dossier il l'ouvre dans l'explorateur windows
        Shell "C:\WINDOWS\EXPLORER.EXE " & TreeView0.SelectedItem.Key & "\", vbNormalFocus
        Exit Sub
    End If
    Set sh = CreateObject("WScript.Shell")
    Set fs = CreateObject("Scripting.FileSystemObject")
    lien = Left(TreeView0.SelectedItem.Key, Len(TreeView0.SelectedItem.Key) - 10) & "\" & TreeView0.SelectedItem.Text
    Set fich = fs.GetFile(lien)
    lien = fich.ShortPath
    sh.Run Chr(34) & lien & Chr(34)
End Sub

Code VBA lister dossier / sous dossier / fichier etc... Problème

Eljojo_e

XLDnaute Nouveau

Paf

XLDnaute Barbatruc

Eljojo_e

XLDnaute Nouveau

Eljojo_e

XLDnaute Nouveau

Discussions similaires