Forums

LOUCAN.FR :: Forums :: Microsoft OFFICE :: Codes VBA
 
<< Previous thread | Next thread >>
XL - Lister les fichiers d'un répertoire
Moderators: Jordane
Author Post
Jordane
Thu Mar 18 2010, 06:38pm

Registered Member #1
Joined: Wed Mar 17 2010, 04:14pm
Posts: 74


Cette fonction permet de lister l'ensemble des fichiers d'un répertoire, de gérer des exclusions (par extention et/ou par leur nom) et d'inscrire le résultat dans une feuille Excel.


Function ListeFichiers(NomF As String, chemin As String, TypF As String, ParamArray Exclu()) As Boolean
'-------------------------------------------------------------------
'Fonction permettant de lister les fichiers d'un répèertoire donnée
' NomF => Nom de la feuille ou copier les données
' Chemin => Répèertoire à scanner
' TypF => type de fichier à récupérer +> par exemple "*.*" ou "*.xls"
' Exclu => liste du/des Fichier(s) à Exclure de la liste
'-------------------------------------------------------------------
'*******************************************************************
'!!!!!!!!!!!!!!!!!!!!!! ATTENTION !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'------------------------------------------------------------------
' Ce code ne fonctionnera pas sous Excel 2007 et plus.
' Il vous faudra surement récupérer la class Filsearch sur le net.
'*****************************************************************
Dim NbFichiers As Integer ' Nb de fichiers dans le répertoire
Dim NomFichier As String ' Nom du fichier
Dim XCLU As Boolean ' test si trouve des fichiers a exlure
XCLU = False 'valeur par défaut

With Application.FileSearch
.LookIn = chemin
.Filename = TypF
If .Execute > 0 Then
ListeFichiers = True
NbFichiers = .FoundFiles.Count

'------ parcoure le répèrtoire
For i = 1 To NbFichiers
NomFichier = .FoundFiles(i)

'------ Test si fait parti des exclusions
For j = 0 To UBound(Exclu)
If NomFichier Like Exclu(j) Then
XCLU = True
Else
'XCLU = False
End If
Next j

'-----' Recopie des données dans la feuille choisie
If XCLU <> True Then
Sheets(NomF).Activate ' activation de la feuille
' Recherche de la dernière ligne + 1
On Error GoTo suite
DernLign = Sheets(NomF).Columns(1).Find("*", , LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
suite:
Sheets(NomF).Cells(DernLign + 1, "A").Value = NomFichier
End If
Next i
Else
ListeFichiers = False
End If
End With

End Function


Et pour appeller la fonction on peut utiliser le code suivant :

LF = ListeFichiers("Liste_Fichiers", "d:", "*.*", "*.ini", "*.txt")




[ Edited Thu Mar 18 2010, 06:39pm ]

Cordialement,
Jordane.
www.jr.loucan.fr
Back to top
Jordane
Tue Mar 30 2010, 02:43pm

Registered Member #1
Joined: Wed Mar 17 2010, 04:14pm
Posts: 74
Sous Office 2007, la fonction FileSearch n'est pas disponible.
Il faut utiliser la classe suivante :


Vous pouvez retrouver les informations sur cette 'classe' sur le site développez.com
à l'adresse suivante : http://silkyroad.developpez.com/vba/classefilesearch/

L'article est également disponible en téléchargement directement ici.




classefilesearch.zip

Cordialement,
Jordane.
www.jr.loucan.fr
Back to top
Jordane
Mon Sep 05 2011, 02:03pm

Registered Member #1
Joined: Wed Mar 17 2010, 04:14pm
Posts: 74
ClasseFileSearch (office 2007 )

Il est possible d'utiliser cette fonction SANS passer par une macro complémentaire.
Pour cela, mettez le code de la classe directement dans votre classer,
puis, dans votre code, au moment d'appeler la fonction modifier la déclaration de la variable recherche :



Dim Recherche As New ClasseFileSearch
Set Recherche = Nouvelle_Recherche



Cordialement,
Jordane.
www.jr.loucan.fr
Back to top
Jordane
Fri Aug 22 2014, 05:11pm

Registered Member #1
Joined: Wed Mar 17 2010, 04:14pm
Posts: 74
Version complète : Utilisation directe depuis son classeur excel....
Pour utiliser ClasseFileSearch :

Dans un module de classe nommé : ClasseFileSearch


Option Compare Text
Option Base 1
'-------------------------------------------------
'Module de classe ClasseFileSearch pour Excel 2007
'SilkyRoad
'http://silkyroad.developpez.com/
'Mise à jour le 01.07.2007
'-------------------------------------------------

'La procédure recherche des fichiers en fonction des critères
'spécifiés et renvoie dans un tableau :
    
    'Le nom des fichiers
    'Le chemin
    'La taille des fichers (en octets)
    'La date de création
    'La date de dernière modification
    'Le type de fichier)

'-------------------------------------------------

'Enumération pour les options de tri
Public Enum Sort_By
    Sort_None
    sort_Name
    sort_Path
    sort_Size
    sort_DateCreated
    sort_LastModified
    sort_Type
End Enum


Dim TabFiles() As InfosResultFichiers
Dim DirectoryPath As String
Dim lngFoundFilesCount As Long
Dim boolSousRep As Boolean
Dim strExtens As String
Dim optionSortBy As Long



'Propriété pour le répertoire de recherche
Public Property Let FolderPath(strFolderPath As String)
    DirectoryPath = strFolderPath
End Property


'Propriété pour rechercher dans les sous dossiers
Public Property Let SubFolders(boolSubFolders As Boolean)
    boolSousRep = boolSubFolders
End Property


'Propriété pour lister les fichiers correspondants à la requête
Public Property Get Files(Idx As Long) As InfosResultFichiers
    Files = TabFiles(Idx)
End Property


'Propriété pour l'extension des fichiers à rechercher
Public Property Let Extension(strExtension As String)
    strExtens = strExtension
End Property


'Propriété pour compte le nombre de fichiers
Public Property Get FoundFilesCount() As Long
    FoundFilesCount = lngFoundFilesCount
End Property


'Propriété pour l'option de tri
Public Property Let SortBy(lngSortBy As Sort_By)
    optionSortBy = lngSortBy
End Property


'Fonction d'exécution
Public Function Execute() As Long
    'Lance la recherche
    ListeFichiers DirectoryPath
    
    'Vérifie que des fichiers ont été trouvés et qu'une option de tri a
    'été spécifié avant de lancer la procédure de tri.
    If lngFoundFilesCount > 1 And optionSortBy <> Sort_By.Sort_None Then _
        FonctionTri optionSortBy
        
    Execute = lngFoundFilesCount
End Function



'Procédure pour lister les fichiers
Private Sub ListeFichiers(strFolderName As String)
    Dim Fso As Object
    Dim NomDossier As Object, SousDossier As Object
    Dim objFichier As Object
    
    On Error GoTo Fin
    
    
    'Vérifie si le dossier spécifié existe
    If Dir(strFolderName, vbDirectory Or vbHidden Or vbSystem) = "" Then Exit Sub
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set NomDossier = Fso.GetFolder(strFolderName)
    
    
    'Boucle sur les fichiers du répertoire
    For Each objFichier In NomDossier.Files
        
        'Vérifie l'extension du fichier
        If objFichier.Name Like strExtens Or strExtens = "" Then
            
            'Redimensionne le tableau pour ajouter un nouvel élément
            lngFoundFilesCount = lngFoundFilesCount + 1
            ReDim Preserve TabFiles(lngFoundFilesCount)
            
            'Nom fichier
            TabFiles(lngFoundFilesCount).strFileName = objFichier.Name
            'Répertoire
            TabFiles(lngFoundFilesCount).strPathName = objFichier.ParentFolder
            'Taille du fichier (en octets)
            TabFiles(lngFoundFilesCount).lngSize = objFichier.Size
            'Date de création
            TabFiles(lngFoundFilesCount).DateCreated = objFichier.DateCreated
            'Date de création ou dernière modification
            TabFiles(lngFoundFilesCount).DateLastModified = objFichier.DateLastModified
            'Type de fichier
            TabFiles(lngFoundFilesCount).strFileType = objFichier.Type
        End If
    Next objFichier
    
    
    'Boucle récursive:
    '(Si l'option de recherche dans les sous répertoires a été spécifiée)
    If boolSousRep Then
        For Each SousDossier In NomDossier.SubFolders
            ListeFichiers SousDossier.Path
        Next SousDossier
    End If
    
    
Exit Sub:

Fin:
MsgBox "Erreur '" & Err.Number & "'" & vbCrLf & vbCrLf & _
    Err.Description, vbInformation
End Sub



'Procédure de tri (reste à améliorer).
Private Sub FonctionTri(optionSortBy As Sort_By)
    Dim i As Long, j As Long, k As Long
    Dim ValTemp As Variant
    
    'Vérifie quel champ du tableau doit être trié
    Select Case optionSortBy
                  
        Case Sort_By.sort_Name
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).strFileName <= TabFiles(j).strFileName Then j = k
                    If TabFiles(k).strFileName <= TabFiles(j).strFileName Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                    ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                        
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
    
    
         Case Sort_By.sort_Path
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).strPathName <= TabFiles(j).strPathName Then j = k
                    If TabFiles(k).strPathName <= TabFiles(j).strPathName Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                    ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                        
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
   
   
          Case Sort_By.sort_Size
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).lngSize <= TabFiles(j).lngSize Then j = k
                    If TabFiles(k).lngSize <= TabFiles(j).lngSize Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                     ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                        
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
  
  
        Case Sort_By.sort_DateCreated
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).DateCreated <= TabFiles(j).DateCreated Then j = k
                    If TabFiles(k).DateCreated <= TabFiles(j).DateCreated Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                     
                     ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                        
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
            
  
        Case Sort_By.sort_LastModified
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).DateLastModified <= TabFiles(j).DateLastModified Then j = k
                    If TabFiles(k).DateLastModified <= TabFiles(j).DateLastModified Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                     ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                   
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
  
         Case Sort_By.sort_Type
            For i = LBound(TabFiles) To UBound(TabFiles)
                j = i
                For k = j + 1 To UBound(TabFiles)
                    If TabFiles(k).strFileType <= TabFiles(j).strFileType Then j = k
                    If TabFiles(k).strFileType <= TabFiles(j).strFileType Then j = k
                Next k
                
                If i <> j Then
                    ValTemp = TabFiles(j).strFileName: TabFiles(j).strFileName = _
                        TabFiles(i).strFileName: TabFiles(i).strFileName = ValTemp
                     
                     ValTemp = TabFiles(j).strPathName: TabFiles(j).strPathName = _
                        TabFiles(i).strPathName: TabFiles(i).strPathName = ValTemp
                
                    ValTemp = TabFiles(j).lngSize: TabFiles(j).lngSize = _
                        TabFiles(i).lngSize: TabFiles(i).lngSize = ValTemp
                        
                      ValTemp = TabFiles(j).DateCreated: TabFiles(j).DateCreated = _
                        TabFiles(i).DateCreated: TabFiles(i).DateCreated = ValTemp
                  
                    ValTemp = TabFiles(j).DateLastModified: TabFiles(j).DateLastModified = _
                        TabFiles(i).DateLastModified: TabFiles(i).DateLastModified = ValTemp
                        
                    ValTemp = TabFiles(j).strFileType: TabFiles(j).strFileType = _
                        TabFiles(i).strFileType: TabFiles(i).strFileType = ValTemp
                End If
            Next i
    
    End Select
End Sub





Dans un MODULE "standard" :

Option Explicit

Public Type InfosResultFichiers
    strFileName As String
    strPathName As String
    lngSize As Long
    DateCreated As Date
    DateLastModified As Date
    strFileType As String
End Type


Public Function Nouvelle_Recherche() As ClasseFileSearch
    Set Nouvelle_Recherche = New ClasseFileSearch
End Function


Function ListeFichiers(NomF As String, chemin As String, Recursif As Boolean, ParamArray Exclu())
'-------------------------------------------------------------------
'Fonction permettant de lister les fichiers d'un répèertoire donnée
' NomF => Nom de la feuille ou copier les données
' Chemin => Répèertoire à scanner
' Recursif => Mode récursif ou non (recherche dans les sous dossiers)
' Exclu => liste du/des Fichier(s) à Exclure de la liste
'-------------------------------------------------------------------
'******************************************************************
Dim arrFile As Variant ' tableau contenant la liste des fichiers trouvés
    arrFile = Array(1)
Dim NbFichiers As Integer ' Nb de fichiers dans le répertoire
Dim NomFichier As String ' Nom du fichier
Dim XCLU As Boolean ' test si trouve des fichiers a exlure
XCLU = False 'valeur par défaut
Dim Recherche As New ClasseFileSearch
Set Recherche = Nouvelle_Recherche
Dim i As Long
Dim j As Long
Dim x As Long

With Recherche
    .FolderPath = chemin
    .SubFolders = Recursif
    If .Execute > 0 Then

        NbFichiers = .FoundFilesCount
        '----------------------------------------------------
        '------ parcoure le répèrtoire
        '----------------------------------------------------
        For i = 1 To NbFichiers
            NomFichier = .Files(i).strFileName
            chemin = .Files(i).strPathName
            '----------------------------------------------------
            '------ Test si fait parti des exclusions
            '----------------------------------------------------
            For j = 0 To UBound(Exclu)
                If NomFichier Like Exclu(j) Then
                    XCLU = True
                End If
            Next j
            
            '----------------------------------------------------
            ' ------ Traitement si le fichier correspond à la recherche
            '----------------------------------------------------
            If XCLU <> True Then
                If NomFichier Like NomF Then
                    'Ajout du fichier dans la variable tableau
                    x = UBound(arrFile)
                    ReDim Preserve arrFile(x + 1)
                    arrFile(x) = chemin & "" & NomFichier
                End If
            End If
        Next i
     End If
End With
ListeFichiers = arrFile
End Function



Et enfin...
Pour l'utiliser il te suffit ensuite de mettre (par exemple) :

Sub test()
Dim mesFichiers As Variant
Dim f As Long
Dim Numcapa As String
    Numcapa = "Export*"
mesFichiers = ListeFichiers(Numcapa & "*.xls", "C:\TEMP", True, False)

For f = 1 To UBound(mesFichiers) - 1
    Debug.Print mesFichiers(f)
Next


End Sub




.Cdt,
jordane


Cordialement,
Jordane.
www.jr.loucan.fr
Back to top
 

Jump:     Back to top

Syndicate this thread: rss 0.92 Syndicate this thread: rss 2.0 Syndicate this thread: RDF
Powered by e107 Forum System