XL 2016 Liste des repertoires d'un repertoire.

[christ77000]

Bonsoir à tous,
j'ai cherché sur pleins de forum y compris sur celui-ci un code permettant de lister les répertoires d'un répertoire donné.

En G7 le chemin d'accès au répertoire principale.

G7 = c:\Users\Christophe\mes fichiers\ (peut varier car liste déroulante de chemin.

et dans mes fichiers\ il y a tous mes répertoires.

mes fichiers\repertoire1
mes fichiers\repertoire2
mes fichiers\repertoire3 ect...

et donc je voudrais extraire la liste de ces répertoires dans la colonne T de ma feuille "Menu"

Merci pour votre aide

 

[Dranreb]

Bonsoir.
Utilisez Dir([G7].Value, vbDirectory)
S'il faut tous les sous-répertoires j'utiliserai plutôt un Folder de la bibliothèque Scripting (référence Microsoft Scripting Runtime) dans une procédure récursive.

 

[christ77000]

heu je débute , la ca va trop vite pour ma faible compréhension du VBA

j'ai trouver un code qui ferait l'affaire... est ce ca la procedure recursive.

Sub DossiersFichiers(SourceFolderName As String)
    Dim Fso As Object, SourceFolder As Object, SubFolder As Object
    Dim i As Integer
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(SourceFolderName)
    
    i = 4
    
    'Cells(i, 20) = SourceFolder.Name
    Cells(i, 1) = SourceFolder.Files.Count
 
    
    For Each SubFolder In SourceFolder.SubFolders
        i = i + 1
        Cells(i, 20) = SubFolder.Name
      
      
      
    Next SubFolder
End Sub

Sub Test()
    DossiersFichiers = range ("G7").value
End Sub

 

[christ77000]

J'ai un peut modifier ce code en retirant le comptage des répertoires, mais je n'arrive pas a mettre dans sub test() Dossiers = range("G7").value

Sub Dossiers(SourceFolderName As String)
Dim Fso As Object, SourceFolder As Object, SubFolder As Object
Dim i As Integer

Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(SourceFolderName)

i = 3

For Each SubFolder In SourceFolder.SubFolders
i = i + 1
Cells(i, 20) = SubFolder.Name



Next SubFolder
End Sub

Sub Test()
Dossiers "c:\Users\Christophe\mes fichiers\"
End Sub

 

[christ77000]

Bonjour, j'ai fais pas mal de test pour essayer de faire Dossiers = range("G7").value mais je n'y arrive pas ou alors ce n'est pas la bonne méthode mais je ne suis pas assez callé pour faire mieux. si quelqu'un avais mieux je suis preneur. Merci

 

[jmfmarques]

Bonjour à tous
La lecture attentive de la demande (si précise) montre qu'il ne s'agirait que de lister les sous-dossiers d'un dossier spécifié (et non les sous-dossiers etc ... de ces sous-dossiers)
Aucune procédure récursive n'est dans ce cas nécessaire.
La fonction Dir fait parfaitement un tel travail et il se trouve qu'un exemple (rubrique Dir, fonction, exemple) de cela (liste des sous-dossiers d'un dossier) accompagne la rubrique Lien supprimé de l'aide interne VBA, que j'invite donc christ77000 à ouvrir et lire.

 

[zebanx]

Bonjour à tous,

Pas mal de fichiers sur le fil ci-joint qui permettent d'un peu tout extraire, comme les sous-répertoires et les fichiers qui sont dedans aussi.

Lister les fichiers et sous-répertoire d'un répertoire

Amis d'excel, Bonjour, Je vous sollicite pour lister les fichiers et sous-répertoire d'un répertoire Je voudrais pouvoir choisir la racine avec une "invite" et choisir l'emplacement (une cellule de la feuille en cours) pour commencer le listing. Merci pour votre aide. Faberiz

www.excel-downloads.com

xl-ment,
zebanx

 

[Dranreb]

Boujour.

j'ai fais pas mal de test pour essayer de faire Dossiers = range("G7").value

Il n'y a pas de '=' à mettre pour spécifier un argument d'une Sub lors de son appel.
simlplement : Dossiers Range("G7").value

Non, ça ce n'est pas une procédure récursive: elle ne s'appelle pas elle même pour sortir tous les sous répertoires des sous-sous-répertoires des … etc.

 

[christ77000]

merci à vous pour votre aide si précieuse. Bon week end

 

[patricktoulon]

bonjour
si c'est juste pour lister les dossiers dans un dossier parent (pas les sub sub sub dossiers)
non recursif et sans sortir l'artillerie lourde FSO on le fait avec dir

Sub Dossiers(SourceFolderName As String)
    Dim i%, subfolder
    i = 3
    subfolder = Dir(SourceFolderName, vbDirectory)
    Do Until subfolder = vbNullString
        If Left(subfolder, 1) <> "." Then
            If (GetAttr(SourceFolderName & subfolder) And vbDirectory) = vbDirectory Then
                Cells(i, 20) = subfolder: i = i + 1
            End If
        End If
        subfolder = Dir
    Loop
End Sub

Sub Test()
    Dossiers Environ("userprofile") & "\DeskTop\mes fichiers\"' adapter le dossier
End Sub

de même qu'en récursif pour chopper les sub sub dossiers d'ailleurs