VBA Liste Dossiers et sous-dossiers d'un dosssier

MJ13

XLDnaute Barbatruc
Bonjour à tous


Je me permet de vous demander une aide pour avoir la liste des dossiers (ou répertoire) et sous-dossiers d'un Dossier.

J'ai trouvé des tas de codes mais en général on a le nom des fichiers avec.

Le but serait d'avoir le nom des dossiers à trouver en A1 (ex: C:\temp) et que la macro liste l'ensemble des sous-dossiers.

Merci d'avance.
 

Msieudjim

XLDnaute Nouveau
rebonjour, désolé pour mon manque de precision
je parle du programme pour lister les dossiers et sous-dossiers
mon ordinateur tour sous win10 64 bits et j'utilise excel 2016.
Dans le module mglob voici ce qu'il y a
Option Explicit

Public Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
Public Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean

Public Debut As Currency, Fin As Currency, Freq As Currency
Public r As Long, d As Long, f As Long
Public iNiveau As Long
Public bDossier As Boolean, bCoulDossiers As Boolean
Public bCoulFichiers As Boolean, bLien As Boolean, bLienD As Boolean
Public iMaxi As Long, bAutoFit As Boolean, bRecur As Boolean
Public Dini As String, CDini As String, CFini As String, AutoIni As String
Public RecurIni As String, LienIni As String, LienDini As String
Public Const NomFichierIni As String = "DSF.ini"

excel me met en erreur et me dit que la fonction 'function' n'est pas adaptee pour un systeme 64 bits et qu'il faut l'adapter.
c'est pourquoi je fait appel a vous
en tout cas merci pour la rapidite de votre reponse d'hier
j'espere avoir ete un peu plus clair et ces renseignements vous permettrons de demeler mon petit probleme
d'avance merci
 

Roland_M

XLDnaute Barbatruc
Bonjour,

c'est effectivement à cause de la déclaration qui n'est pas correcte avec 64 bits !
une petite recherche permet de trouver cet exemple très explicite

Code:
#If Win64 Then
    Public Declare PtrSafe Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
    Public Declare PtrSafe Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
   #Else
    Public Declare Function QueryPerformanceCounter Lib "kernel32" (X As Currency) As Boolean
    Public Declare Function QueryPerformanceFrequency Lib "kernel32" (X As Currency) As Boolean
#End If
 

Msieudjim

XLDnaute Nouveau
rebonjour
c'est encore moi
cette fois j'ai une erreur type mismatch sur les lignes ici dans le userform

Private Sub CommandButton1_Click()
Dim sChemin As String, sCol As String

sChemin = ThisWorkbook.Path

bDossier = Dini
bCoulFichiers = CFini
bCoulDossiers = CDini
bAutoFit = AutoIni

bRecur = RecurIni
bLien = LienIni
bLienD = LienDini


SaveINI

Désolé pour mon manque de connaissance mais je sais pas quoi ni ou changer
 

VIARD

XLDnaute Impliqué
re

mais comment veux tu que l'on puisse deviner avec si peu de détails et sans classeur ?
on ne sait déjà pas comment sont déclarés tes variables !?
Bonjour Roland, Zeltron à toutes et tous

Pour répondre à la recherche de fichiers, il y a quelque temps j'ai éprouvé le besoin de faire mon propre système.
Dedans il y a la recherche de dossiers et sousdossiers de "Tototiti" le reste est de mon cru, toutes les listes sélectionnées sont imprimables.
Au fil du temps le programme a grossi. Si bien que l'on peut lister une série de livres, ou films, voir un diaporama de photo, ou écouter de la musique etc.
J'ai placé quelques exemples.
le programme est organisé par thème, donc facile à lire.

A+ Jean-Paul
 

Pièces jointes

  • Dossiers_Fichiers(1).zip
    1.2 MB · Affichages: 225

hornman

XLDnaute Nouveau
Bonjour à tous,
mes connaissances en VBA sont très faibles j'ai apporté une modification de manière à obtenir la liste complète de l'arborescence des dossiers (Set fso = sousRep):
Sub TousLesDossiers(LeDossier$, Idx As Long)
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
Next
'traitement récursif des sous dossiers
For Each sousRep In Dossier.subfolders
TousLesDossiers sousRep.Path, Idx
Next sousRep
Set fso = sousRep
End Sub 'fs
Sub test()
TousLesDossiers "P:\documents\", 0
End Sub

J'aimerai aussi ajouter la date de création des dossiers dans une autre cellule et limiter aussi le nombre de sous dossiers listés à partir de P:\documents\ à 3 sous dossiers, j'ai tenté différentes modifications mais sans succès :(

Si quelqu'un, avait la solution ....
merci d'avance
 
Dernière édition:

hornman

XLDnaute Nouveau
Bonsoir,

à hornmam !

voir si cet exemple pourrait convenir !
Bonjour Roland_M,
merci beaucoup pour le travail effectué, c'est exactement ce que je cherchais avec les 2 dates de création et de modifications.
Je rencontre un petit soucis, bizarrement le script ne remonte pas tous les sous répertoires.
Pour certains dossiers l'arborescence s'arrête au niveau 2 à partir du dossier racine (\xxx\yyy)
J'ai modifié la valeur de If MaxSousRep à 7 mais pour autant, cela affiche bien certains sous_dossiers qui étaient absents avec la valeur par défaut 3 mais pas tous.
J'ai passé le valeur à 10 et là certains dossiers qui s'affichaient avec 7 ne sont plus présents.


Code:
For Each SousRep In Rep.SubFolders
If MaxSousRep <= 3 Then '################### ICI LE Nbr de SousRep maxi #############################
  If (SousRep.Attributes And 1024) = 0 Then LoadArboresSeulSuite_ByRef SousRep, NbrDeRep, MaxSousRep
Else: MaxSousRep = 0

Pour info, j'exécute le fichier sous excel 2013 pro et windows 10 ou 8.1 sur 2 PC différents.

Merci
 

Roland_M

XLDnaute Barbatruc
bonjour,

effectivement je n'était pas très chaud pour cette limite à 3 sous reps !?
car ce n'est pas évident avec la boucle récursive !?

je peux y regarder mais je vois pas trop bien où agir !?
as-tu vraiment besoin de limiter à 3 ?
 
Dernière édition:

Discussions similaires

Réponses
9
Affichages
259

Statistiques des forums

Discussions
311 729
Messages
2 081 966
Membres
101 852
dernier inscrit
dthi16088