IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Contribuez Discussion :

[VBA-*]Lister les sous-répertoires et les fichiers de ceux-ci


Sujet :

Contribuez

  1. #1
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 546
    Points
    15 546
    Par défaut [VBA-*]Lister les sous-répertoires et les fichiers de ceux-ci
    Demande de valider la référence "Microsoft Scripting Runtime"

    Inspiré de l'aide en ligne
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    Sub ListerLesSsRepEtLeursFichiers() '(Chemin) 'chemin peut être passé en paramètres
        Dim fso, ListR, sRep, ListF, Rep, LesReps, fich, LesFichs
        Set fso = CreateObject("Scripting.FileSystemObject")
        Chemin = "c:\Program files"
        Set ListR = fso.GetFolder(Chemin)
        Set sRep = ListR.SubFolders
        For Each Rep In sRep
            LesReps = LesReps & Rep.Name
            LesReps = LesReps & vbCrLf
            Set ListF = Rep.Files
            For Each fich In ListF
                LesFichs = LesFichs & fich.Name
                LesFichs = LesFichs & vbCrLf
            Next
            If LesFichs <> "" Then
                  MsgBox LesFichs, 0, "Fichiers du répertoire " & Rep.Name
              Else
                  MsgBox "Il n'y a pas de fichier dans ce répertoire !", 0, "Répertoire " & Rep.Name
            End If
            LesFichs = ""
        Next
        MsgBox LesReps, 0, "Répertoires du dossier " & Chemin
    End Sub

  2. #2
    Modérateur
    Avatar de AlainTech
    Homme Profil pro
    Consultant informatique
    Inscrit en
    Mai 2005
    Messages
    4 235
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 70
    Localisation : Belgique

    Informations professionnelles :
    Activité : Consultant informatique
    Secteur : Finance

    Informations forums :
    Inscription : Mai 2005
    Messages : 4 235
    Points : 24 327
    Points
    24 327
    Par défaut
    Celle-là, je l'avais déjà faite...
    http://www.developpez.net/forums/sho...d.php?t=200523

  3. #3
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 546
    Points
    15 546
    Par défaut
    Pour placer les sous répertoires dans des cellules d'une feuille de calculs, voir par megapacman

  4. #4
    Membre habitué
    Homme Profil pro
    Consultant informatique
    Inscrit en
    Septembre 2011
    Messages
    112
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Consultant informatique
    Secteur : Industrie

    Informations forums :
    Inscription : Septembre 2011
    Messages : 112
    Points : 191
    Points
    191
    Par défaut lister tous les fichiers d'un type donné dans un répertoire et toute son arborescence
    Une petite variante adaptée de cette procédure qui permet de lister les fichiers d'un type donné (ici des images jpeg) dans un répertoire et toute l'arborescence de celui-ci.
    Cette procédure est récursive, je n'ai pas trouver de moyen de faire autrement, ça peut être un peu long si vous souhaitez scanner un disque dur entier.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
     
    'La routine doit être appelée avec comme argument le chemin du dossier racine que l'on veut scanner
     
    Sub RecupTypeImage(rPath As String)
    Dim oFSO As Scripting.FileSystemObject
    Dim rFld As Scripting.Folder
    Dim cFld As Scripting.Folder
    Dim oFl As File
     
    'Appelle la routine permettant d'explorer les fichier windows
    Set oFSO = New Scripting.FileSystemObject
    'Va chercher le dossier de travail à l'adresse rPath
    Set rFld = oFSO.GetFolder(rPath)
     
    'La fonction étant appelée plusieurs fois consécutivement, il faut récupérer la première ligne vierge.
    'Géré ici avec une boucle, il doit être possible de stocker la variable en global pour gagner en efficacité.
     
    Dim line As Integer
    line = 1
    Do Until ThisWorkbook.Sheets(2).Cells(ligne, 1) = ""
    line = line + 1
    Loop
    'POUR CHAQUE sous dossier
    'appel de la fonction avec comme argument le dit sous dossier
    For Each cFld In rFld.subfolders
        RecupTypeImage (cFld.Path)
    Next cFld
    'POUR CHAQUE fichier du dossier
    'SI le fichier est du type désiré (ici jpg)
    'ALORS On entre dans le classeur le nom du fichier en colonne 1 et son chemin en colonne 2
    'enfin on incrémente le numéro de ligne
    For Each oFl In rFld.Files
        If oFl.Type = "Image JPEG" Then 'Il est possible d'ajouter plusieurs types (gif, png...) en ajoutant or oFl.Type = "...
            ThisWorkbook.Sheets(1).Cells(ligne, 1) = oFl.Name
            ThisWorkbook.Sheets(1).Cells(ligne, 2) = oFl.Path
            line = line + 1
        End If
    Next oFl
    End Sub
    Je l'ai couplé chez moi à un UserForm qui appelle l'explorateur de fichier Windows pour récupérer le chemin du dossier racine.

  5. #5
    Expert éminent sénior
    Avatar de Marc-L
    Homme Profil pro
    Développeur informatique
    Inscrit en
    Avril 2013
    Messages
    9 468
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : Avril 2013
    Messages : 9 468
    Points : 18 674
    Points
    18 674
    Par défaut

    Quand c'est trop long, ne pas utiliser FSO mais directement la fonction interne au VBA Dir bien plus véloce …

  6. #6
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 272
    Points
    11 272
    Par défaut
    Salut, via les API, trouvé sur le web il y a longtemps sans avoir conservé la référence

    Dans un module standard
    Affecter un bouton à SelDossierRacine
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    Option Explicit
     
    Private Const RDepart = 5
    Private Const vbDot = 46
    Private Const MAX_PATH As Long = 260
    Private Const INVALID_HANDLE_VALUE = -1
    Private Const vbBackslash = "\"
    Private Const ALL_FILES = "*.*"
     
    Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
     
    Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
    End Type
     
    Private Type FILE_PARAMS
        bRecurse As Boolean
        bFindOrExclude As Long
        nCount As Long
        nSearched As Long
        sFileNameExt As String
        sFileRoot As String
    End Type
     
    Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    Private Declare Function FindFirstFile Lib "kernel32" _
            Alias "FindFirstFileA" _
            (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindNextFile Lib "kernel32" _
            Alias "FindNextFileA" _
            (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long
    Private Declare Function PathMatchSpec Lib "shlwapi" _
            Alias "PathMatchSpecW" _
            (ByVal pszFileParam As Long, ByVal pszSpec As Long) As Long
     
    Private fp As FILE_PARAMS
     
    Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
    Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean
     
    Dim NbDossiers As Long
     
    Sub SelDossierRacine()
    Dim sChemin As String
        sChemin = ThisWorkbook.Path
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = sChemin & "\"
            .Title = "Sélectionner le Dossier Racine"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewDetails
            .ButtonName = "Sélection Dossier"
            .Show
            If .SelectedItems.Count > 0 Then
                Rch .SelectedItems(1)
                NbDossiers = 0
            End If
        End With
    End Sub
     
    Private Sub Rch(sRacine As String)
    Dim Debut As Currency, Fin As Currency, Freq As Currency
     
        With ShDatas
            .Cells.Clear
            .Cells(1, 1) = sRacine
            .Cells(2, 1) = "ALL_FILES"
            .Cells(3, 1) = ""
            .Cells(4, 1) = ""
            .Cells(5, 1) = ""
            .Range("B:B").Clear
        End With
     
        ActiveWindow.ScrollRow = 1
        ActiveWindow.ScrollColumn = 1
     
        Application.ScreenUpdating = False
        With fp
            '   start path
            .sFileRoot = QualifyPath(ShDatas.Cells(1, 1))
            '   file type(s) of interest
            .sFileNameExt = ShDatas.Cells(2, 1)
            .bRecurse = True
            .nCount = 0
            .nSearched = 0
     
            '   0=include, 1=exclude
            .bFindOrExclude = 0
        End With
     
        QueryPerformanceCounter Debut
        SearchForFiles fp.sFileRoot
        QueryPerformanceCounter Fin
        QueryPerformanceFrequency Freq
     
        With ShDatas
            .Cells(3, 1) = Format$(fp.nSearched, "###,###,###,##0")
            .Cells(4, 1) = NbDossiers & " // " & Format$(fp.nCount, "###,###,###,##0")
            .Cells(5, 1) = FormatNumber((Fin - Debut) / Freq, 2) & " s"
     
            .Range("A1:A5").HorizontalAlignment = xlLeft
            .Range("B2").Select
        End With
     
        Application.ScreenUpdating = True
    End Sub
     
    Private Sub SearchForFiles(sRoot As String)
    Dim WFD As WIN32_FIND_DATA
    Dim hFile As Long
        hFile = FindFirstFile(sRoot & ALL_FILES, WFD)
        If hFile <> INVALID_HANDLE_VALUE Then
            Do
                '   if a folder, and recurse specified, call method again
                If (WFD.dwFileAttributes And vbDirectory) Then
                    If Asc(WFD.cFileName) <> vbDot Then
                        NbDossiers = NbDossiers + 1
                        If fp.bRecurse Then SearchForFiles sRoot & TrimNull(WFD.cFileName) & vbBackslash
                    End If
                Else
                    '   must be a file ..
                    If MatchSpec(WFD.cFileName, fp.sFileNameExt) Then
                        fp.nCount = fp.nCount + 1
                        ShDatas.Cells(fp.nCount + RDepart, 2) = sRoot & TrimNull(WFD.cFileName)
                    End If
                End If
                fp.nSearched = fp.nSearched + 1
            Loop While FindNextFile(hFile, WFD)
            Application.StatusBar = NbDossiers & " / " & fp.nCount
        End If
        FindClose hFile
    End Sub
     
    Private Function QualifyPath(sPath As String) As String
        If Right$(sPath, 1) <> vbBackslash Then
            QualifyPath = sPath & vbBackslash
        Else
            QualifyPath = sPath
        End If
    End Function
     
    Private Function TrimNull(startstr As String) As String
        TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
    End Function
     
    Private Function MatchSpec(sFile As String, sSpec As String) As Boolean
        MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec)) = fp.bFindOrExclude
    End Function

  7. #7
    Membre éprouvé

    Profil pro
    Inscrit en
    Janvier 2010
    Messages
    983
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Janvier 2010
    Messages : 983
    Points : 1 030
    Points
    1 030
    Billets dans le blog
    36
    Par défaut
    Bonjour à tous et merci pour toutes ces infos.

    J'ai recopié le code de kiki29 pour l'adapter en 64bits ici

    Par contre je ne sais pas récupérer les valeurs de l'objet WIN32_FIND_DATA de type long.
    Donc merci de votre aide pour le bout de code afin de récupérer la valeur des variables de type long de l'instance de WIN32_FIND_DATA

    Bonjour chez vous

  8. #8
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 272
    Points
    11 272

  9. #9
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 272
    Points
    11 272
    Par défaut
    Re, qqs recherches mènent ici, à adapter à ton contexte.

Discussions similaires

  1. [Débutant] Compter les fichiers dans les sous répertoires d'un dossier
    Par Pouknouki dans le forum VB.NET
    Réponses: 9
    Dernier message: 25/02/2012, 14h16
  2. Lister les sous repertoires et les fichiers d'un dossier
    Par benito9253 dans le forum Windows Forms
    Réponses: 8
    Dernier message: 03/08/2009, 21h49
  3. Lister les sous-répertoires d'un répertoire
    Par Jean-Luc80 dans le forum VBA Access
    Réponses: 2
    Dernier message: 04/01/2009, 21h08
  4. Réponses: 7
    Dernier message: 10/12/2007, 12h27
  5. [VBA-*]Lister les sous-répertoires et les fichiers de ceux-ci
    Par ouskel'n'or dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 27/04/2007, 23h41

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo