Liste des fichiers du modèle à l'aide de VBA Excel

Comment lister tous les fichiers qui correspondent à un certain modèle à l'intérieur d'un répertoire particulier de l'utilisateur? Cela devrait fonctionner de manière récursive à l'intérieur du sous-dossiers du répertoire sélectionné. J'ai aussi besoin d'un moyen pratique(comme le contrôle d'arborescence) de dresser la liste.

InformationsquelleAutor Manoj | 2009-02-17
  1. 3

    Il semble que quelques réponses de parler de la récursivité, et un sur les regex. Voici un code qui met les deux sujets ensemble. J'ai saisi le code de http://vba-tutorial.com

    Sub FindPatternMatchedFiles()

    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.pattern = ".*xlsx"
    objRegExp.IgnoreCase = True

    Dim colFiles As Collection
    Set colFiles = New Collection

    RecursiveFileSearch "C:\Path\To\Your\Directory", objRegExp, colFiles, objFSO

    For Each f In colFiles
        Debug.Print (f)
        'Insert code here to do something with the matched files
    Next

    'Garbage Collection
    Set objFSO = Nothing
    Set objRegExp = Nothing

End Sub

Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
                ByRef matchedFiles As Collection, ByRef objFSO As Object)

    Dim objFolder As Object
    Dim objFile As Object
    Dim objSubFolders As Object

    'Get the folder object associated with the target directory
    Set objFolder = objFSO.GetFolder(targetFolder)

    'Loop through the files current folder
    For Each objFile In objFolder.files
        If objRegExp.test(objFile) Then
            matchedFiles.Add (objFile)
        End If
    Next

    'Loop through the each of the sub folders recursively
    Set objSubFolders = objFolder.Subfolders
    For Each objSubfolder In objSubFolders
        RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO
    Next

    'Garbage Collection
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objSubFolders = Nothing

End Sub
    • C'est génial! Merci!!!! Pas pu résister moi la copie de ce 😀
    • Ce script m'a sauvé la journée, surtout l'expression rationnelle de la partie est venu très pratique 😀
    InformationsquelleAutor user2780436
  2. 1

    Général pointeur, jetez un oeil à l'Application.FileSearch, fonctions récursives, des Userforms et "Microsoft TreeView de Contrôle".

    FileSearch peut être utilisé pour rechercher des fichiers dans un dossier correspondant à un modèle, une fonction récursive peut s'appeler lui-même jusqu'à ce que tous les chemins ont été épuisés, un objet UserForm peuvent héberger des contrôles pour l'affichage de vos données et le contrôle TreeView pouvez afficher votre système de fichiers.

    Garder à l'esprit qu'il y a des pré-construit fonctions/commandes qui peuvent être utilisées pour l'affichage des systèmes de fichiers, par exemple.GetOpenFileName, Application.GetSaveAsFileName, Microsoft WebBrowser donné une " file://...' URL).

    • Oui, je ne demande pas le code complet... j'ai été à la recherche pour les pointeurs comme ça. Merci...
    • Correct, mais il semble que l'Application.FileSearch n'existe plus que de Office 2007. Vous auriez besoin d'Office 2003.
    InformationsquelleAutor Adam Ralph
  3. 1

    Essayer Windows Scripts - Objets Du Système De Fichiers. Cet objet COM qui peut être créé formulaire vba a des fonctions pour lister les répertoires etc.

    Vous pouvez trouver de la documentation sur MSDN

    InformationsquelleAutor Toby Allen
  4. 1

    Pas exactement ce que vous avez demandé, mais je pensais que j'allais poster cela ici comme il est lié.

    Ceci est une version modifiée du code trouvé à http://www.cpearson.com/excel/FOLDERTREEVIEW.ASPX

    Cela nécessite la référence Microsoft Scripting Runtime.

    Sub ListFilePaths()

    Dim Path As String
    Dim Files As Long

    Path = "C:\Folder"

    Files = GetFilePaths(Path, "A", 1)

    MsgBox "Found " & Files - 1 & " Files"

End Sub

Function GetFilePaths(Path As String, Column As String, StartRow As Long) As Long

    Dim Folder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim File As Scripting.File
    Dim FSO As Scripting.FileSystemObject
    Dim CurrentRow As Long

    Set FSO = New Scripting.FileSystemObject
    Set Folder = FSO.GetFolder(folderpath:=Path)

    CurrentRow = StartRow

    For Each File In Folder.Files
        Range(Column & CurrentRow).Value = File.Path
        CurrentRow = CurrentRow + 1
    Next File

    For Each SubFolder In Folder.SubFolders
        CurrentRow = GetFilePaths(SubFolder.Path, Column, CurrentRow)
    Next SubFolder

    GetFilePaths = CurrentRow

    Set Folder = Nothing
    Set FSO = Nothing
End Function
    InformationsquelleAutor Joe Mako
  5. 1

    Je vois que les gens au dessus de moi ont déjà répondu à la façon d'une boucle à travers l'arborescence de fichiers, Ce qui pourrait vous intéresser dans la recherche de modèles dans le dossier/nom de fichier. C'est une Fonction pour VBA qui permettra à des expressions régulières pour être utilisé.

    Private Function RegularExpression(SearchString As String, Pattern As String) As String

    Dim RE As Object, REMatches As Object

    'Create the regex object' 
    Set RE = CreateObject("vbscript.regexp")
    With RE
        .MultiLine = False
        .Global = False
        .IgnoreCase = True
        'set the search pattern using parameter Pattern'
        .Pattern = Pattern 
    End With

    'Search for the pattern' 
    Set REMatches = RE.Execute(SearchString) 
    If REMatches.Count > 0 Then
        'return the first match'
        RegularExpression = REMatches(0) 
    Else
        'nothing found, return empty string'
        RegularExpression = ""
    End If

End Function

    Vous pouvez utiliser cette fonction pour rechercher les noms de fichiers pour les modèles. Je suggère les expressions régulières à la maison pour plus d'informations sur la façon d'utiliser les expressions Régulières

    InformationsquelleAutor TerrorAustralis