J'ai essayé de créer une classe pour rechercher des fichiers avec la méthode Glob de Python dans VBA

Objectif

Lors de la recherche de dossiers et de fichiers avec VBA, le processus de recherche dans les sous-dossiers devient compliqué, donc J'ai créé un module de classe en référence à Glob de Python.

Code source

Cas d'utilisation VBA

Module1.bas

Sub GlobTest()
    Dim item As Variant
    With New Glob
        .SetType = Dictionary 'Facultatif Pour spécifier le format de sortie
        For Each item In .iGlob("**\*.cls")
            Debug.Print item
        Next
    End With
End Sub

Méthode

Propriété

Type de format de sortie

Conditions de recherche

Exemple de code de référence Python

import glob
for x in glob.glob('**/*.cls', recursive=True):
    print x

Corps du module de classe

Glob.cls

Private DefPath As String
Private Items As Variant
Private FSO As Object

Enum GlobDataType
    None = 0
    StringArray = 1
    ArrayList = 2
    dictionary = 3
    Collection = 4
End Enum

Private Sub Class_Initialize()
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With CreateObject("WScript.Shell")
        .CurrentDirectory = ThisWorkbook.path & "\"
    End With
    Me.Clear
End Sub

Private Sub Class_Terminate()
    Set Items = Nothing
    Set FSO = Nothing
End Sub

Public Sub Clear()

    DefPath = ThisWorkbook.path & "\"
    count = 0
    Select Case Me.GetType
    Case GlobDataType.dictionary
        Me.SetType = dictionary
    Case GlobDataType.Collection
        Me.SetType = Collection
    Case GlobDataType.StringArray
        Me.SetType = StringArray
    Case GlobDataType.ArrayList
        Me.SetType = ArrayList
    Case Else
        Me.SetType = Collection
    End Select

End Sub

Public Function GetItems() As Variant
    Select Case Me.GetType
    Case GlobDataType.dictionary, GlobDataType.Collection, GlobDataType.ArrayList
        Set GetItems = Items
    Case GlobDataType.StringArray
        GetItems = Split(Items, "||")
    Case Else
        GetItems = Array()
    End Select
End Function

Public Function GetCount() As Long
    Select Case Me.GetType
    Case GlobDataType.dictionary, GlobDataType.Collection, GlobDataType.ArrayList
        GetCount = Items.count
    Case GlobDataType.StringArray
        If Items = "" Then
            GetCount = 0
        Else
            GetCount = UBound(Split(Items, "||")) + 1
        End If
    Case Else
        GetCount = -1
    End Select
End Function

Public Sub AddItem(ByVal name As String, ByVal v As Variant)
    Select Case Me.GetType
    Case GlobDataType.dictionary
        Items.Add name, v
    Case GlobDataType.Collection
        Items.Add v, name
    Case GlobDataType.ArrayList
        Items.Add v
    Case GlobDataType.StringArray
        If Items <> "" Then Items = Items & "||"
        Items = Items & v
    End Select
End Sub

Public Property Get GetType() As GlobDataType
    Select Case Me.GetTypeName
    Case "Collection"
        GetType = GlobDataType.Collection
    Case "Dictionary"
        GetType = GlobDataType.dictionary
    Case "String"
        GetType = GlobDataType.StringArray
    Case "ArrayList"
        GetType = GlobDataType.ArrayList
    Case Else
        GetType = GlobDataType.None
    End Select
End Property

Public Property Let SetType(ByVal TypeName As GlobDataType)
    Select Case TypeName
    Case GlobDataType.Collection
        Set Items = Nothing
        Set Items = New Collection
    Case GlobDataType.dictionary
        Set Items = Nothing
        Set Items = CreateObject("scripting.dictionary")
    Case GlobDataType.StringArray
        Items = ""
    Case GlobDataType.ArrayList
        Set Items = Nothing
        Set Items = CreateObject("System.Collections.ArrayList")
    Case Else
        Set Items = Nothing
        Set Items = CreateObject("scripting.dictionary")
    End Select
End Property

Public Function GetTypeName() As String
    GetTypeName = TypeName(Items)
End Function


Private Function base(ByRef url As String, Optional ByRef key As String = "") As String
    Dim baseUrl As String
    Dim min As Long
    Dim keystr As String
    
    If Left$(url, 2) <> "\\" And Left$(url, 1) = "\" Then url = Mid$(url, 2, Len(url) - 1)
    
    If url <> "" Then
        min = 2000
        If InStr(url, "?") And min > InStr(url, "?") Then min = InStr(url, "?")
        If InStr(url, "*") And min > InStr(url, "*") Then min = InStr(url, "*")
        If InStr(url, "[") And min > InStr(url, "[") Then min = InStr(url, "[")
        If InStr(url, "{") And min > InStr(url, "{") Then min = InStr(url, "{")
        If InStr(url, "]") And min > InStr(url, "]") Then min = InStr(url, "]")
        If InStr(url, "}") And min > InStr(url, "}") Then min = InStr(url, "}")
        If min < 2000 Then
            keystr = Left$(Left$(url, min - 1), InStrRev(Left$(url, min - 1), "\"))
            baseUrl = FSO.GetAbsolutePathName(keystr)
            key = Replace$(url, keystr, "")
        Else
            baseUrl = FSO.GetAbsolutePathName(url)
            key = ""
        End If
        If FSO.FolderExists(baseUrl) = True Then
            url = baseUrl
            base = baseUrl
        Else
            url = ""
            base = ""
        End If
    Else
        url = ""
        key = ""
        base = ""
    End If
End Function

Public Function iGlob(Optional ByVal url As String = "") As Variant

    Dim key As String
    key = ""
    Call base(url, key)
    Me.Clear
    Call subSearch(url, key, 0)
    If IsObject(Me.GetItems) = True Then
        Set iGlob = Me.GetItems
    Else
        iGlob = Me.GetItems
    End If

End Function

Public Function Glob(Optional ByVal url As String = "") As Object

    With New Glob
        .SetType = dictionary
        Set Glob = .iGlob(url)
    End With

End Function

Public Function GlobFolder(Optional ByVal url As String = "") As Object

    Dim item As Variant
    Dim List As Object
    Set List = CreateObject("scripting.dictionary")
    With New Glob
        .SetType = Collection
        For Each item In Me.iGlob(url)
            If TypeName(item) = "File" Then
                If List.Exists(item.ParentFolder) = False Then
                    List.Add item.ParentFolder, item.ParentFolder
                End If
            Else
                If List.Exists(item.path) = False Then
                    List.Add item.path, item.path
                End If
            End If
        Next
    End With
    Set GlobFolder = List
    Set List = Nothing

End Function

Private Function subSearch(ByVal baseUrl As String, ByVal key As String, Optional ByVal level As Long = 0) As String

    Dim keyArr As Variant
    Dim folder As Variant
    Dim File As Variant
    
    keyArr = Split(key, "\")
    
    If UBound(keyArr) > level Then
    
        If keyArr(level) = "**" Then
            Call recursive(baseUrl, key, level + 1)
        ElseIf keyArr(level) Like "{*}" Then
        
            For Each folder In FSO.GetFolder(baseUrl).SubFolders
                If folder.name Like keyArr(level) Then
                    Call subSearch(baseUrl & "\" & folder.name, key, level + 1)
                End If
            Next
            Call subSearch(baseUrl, key, level + 1)
        
        Else
        
            For Each folder In FSO.GetFolder(baseUrl).SubFolders
                If folder.name Like keyArr(level) Then
                    Call subSearch(baseUrl & "\" & folder.name, key, level + 1)
                End If
            Next
        
        End If
    
    Else

        If keyArr(level) = "" Then
        
            If FSO.FolderExists(baseUrl) = True Then
                Me.AddItem baseUrl, FSO.GetFolder(baseUrl)
            End If
        
        Else

            For Each File In FSO.GetFolder(baseUrl).Files
                If File.name Like keyArr(level) Then
                    Me.AddItem File, File
                End If
            Next
        
        End If
    
    End If
    
    

End Function

Private Function recursive(ByVal baseUrl As String, ByVal key As String, Optional ByVal level As Long = 0) As String
    
    Dim folder As Variant
    Dim keyArr As Variant
    Dim File As Variant
    
    keyArr = Split(key, "\")
    
    If UBound(keyArr) > level Then
    
        For Each folder In FSO.GetFolder(baseUrl).SubFolders
            If folder.name Like keyArr(level) Then
                Call subSearch(baseUrl & "\" & folder.name, key, level + 1)
            ElseIf "{" & folder.name & "}" Like keyArr(level) Then
                Call subSearch(baseUrl, key, level)
            Else
                Call recursive(baseUrl & "\" & folder.name, key, level)
            End If
        Next

    Else
        For Each folder In FSO.GetFolder(baseUrl).SubFolders
            Call recursive(baseUrl & "\" & folder.name, key, level)
        Next
        For Each File In FSO.GetFolder(baseUrl).Files
            If File.name Like keyArr(level) Then
                Me.AddItem File, File
            End If
        Next
    End If
    
End Function

Tâches futures

• Implémentation de l'échappement des caractères spéciaux et de la spécification des conditions d'expression régulière
• L'opération lorsque vous entrez \ ** \ ** \ n'a pas été vérifiée.
• Tableau implémenté au format de sortie (pour la comparaison de vitesse)

À tous ceux qui utilisent

• Le débogage n'étant pas terminé, nous le passerons en revue s'il y a un problème avec l'opération. Nous vous serions reconnaissants si vous pouviez partager ces informations. Je vous remercie.

Site de référence

• Comment utiliser glob pour obtenir récursivement une liste de chemins qui satisfont aux conditions en Python

• [x] Toute chaîne d'une longueur égale ou supérieure à 0: *

• [x] N'importe quel caractère unique :?

• [x] Caractère spécifique: []

• [] ~~ Échapper les caractères spéciaux ~~

• [x] Obtenir récursivement: ~~ Argument récursif ~~ → Peut être utilisé sans spécifier d'argument

• [x] Obtenir uniquement le nom du fichier

• [x] Récupère uniquement le nom du répertoire

• [] ~~ Spécification des conditions avec des expressions régulières ~~

• [x] Obtenir la liste avec l'itérateur: iglob ()

• glob --- Extension de modèle de chemin d'accès de style Unix

• Résumé des collections de longueur variable pouvant être utilisées avec Excel VBA

• [x] Collection
• [x] Dictionary
• [x] ArrayList
• [ ] ~~SortedList~~

• Mis en œuvre pour la comparaison de la vitesse de traitement

• [Introduction à VBA] Comme opérateur (caractère générique, échappement, refus)

Caractère générique