Petit exemple de fonction recursive

Télécharger le projet
Commenter

Description

Pour exécuter ce code, mettez en vrac dans une form un label, une textbox, une listbox et un bouton de commande ...

Source / Exemple : 


Option Explicit
Private m_fso        

Private Sub Form_Load()
    Set m_fso = CreateObject("Scripting.FileSystemObject")
    Top = (Screen.Height - Form1.Height) / 2
    Left = (Screen.Width - Form1.Width) / 2
    Label1.Height = 255
    Label1.Width = 1455
    Label1.Left = 1200
    Label1.Top = 240
    Label1.Caption = "Répertoire :"
    Text1.Height = 285
    Text1.Width = 2295
    Text1.Left = 3000
    Text1.Top = 240
    Text1.Text = ""
    Command1.Height = 375
    Command1.Width = 1815
    Command1.Left = 3000
    Command1.Top = 840
    Command1.Caption = "&Rechercher les fichiers"
    List1.Height = 3570
    List1.Width = 7695
    List1.Left = 240
    List1.Top = 1560
    List1.Clear
    Me.Caption = "Petit exemple de récursivité"
End Sub

Private Sub Command1_Click()
   Dim l_Collec   As New Collection
   Dim l_Fichier  As Variant
   Dim l_Folder$
   Dim i          As Integer
   
   List1.Clear
   l_Folder$ = Text1.Text
   If m_fso.FolderExists(l_Folder$) Then
      Set l_Collec = BuildFileCollectionRecursive(m_fso.GetFolder(l_Folder$))
      For i = 1 To l_Collec.Count
         On Error Resume Next
         For Each l_Fichier In l_Collec(i)
            List1.AddItem l_Fichier.Name
         Next l_Fichier
      Next
   Else
      MsgBox "Répertoire inexistant", vbOKOnly, "C trop inzuuuste !"
   End If
End Sub

' BuildFileCollectionRecursive : la récurrence s'applique ici
' Pour chaque sous répertoire, la fonction se rappelle elle-même
' et stocke son contenu dans la collection l_Collec
'
Private Function BuildFileCollectionRecursive(p_folder As Folder) As Collection
    Dim l_Folder        
    Dim l_Collec        As Collection
    Dim l_collecRecur   As Collection
    
    On Error Resume Next
    Set l_Collec = New Collection
    Set l_collecRecur = New Collection
    l_Collec.Add p_folder.Files
    For Each l_Folder In p_folder.SubFolders
        Set l_collecRecur = ConcatenateCollections(l_Collec, BuildFileCollectionRecursive(l_Folder))
    Next l_Folder
    Set BuildFileCollectionRecursive = l_Collec
End Function

' ConcatenateCollections : concatène le contenu de
' la deuxième collection à la première
'
Private Function ConcatenateCollections(p_Collec1 As Collection, p_Collec2 As Collection) As Collection
    Dim l_fic As Variant
    Dim l_Collec As Collection
    
    For Each l_fic In p_Collec2
        p_Collec1.Add l_fic
    Next l_fic
    Set l_Collec = ConcatenateCollections
End Function

Conclusion :


Référencez "Microsoft Scripting Runtime" pour utiliser les collections.
Utilisez le mode pas-à-pas pour voir ce qui se passe dans ce code
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_muad-dib)