Scanlist v2.1

Télécharger le projet
Commenter

Description

Mon petit programme sert a scanner un repertoire et à faire une liste des sous dossiers et fichiers contenus de ce repertoire. La liste ecrite est visible dans un controle texte et il est possible de l'enregistrer au format .txt
Utile pour créer une liste de tous vos fichiers multimédias.
Je l'ai optimisé du mieu que j'ai pu. Pour la version 1 il listait 24000 fichier en 6min! Avec la version 2 il faut 12sec pour 24000 fichiers! Aprés la vitesse peut dépendre du materiel.

Source / Exemple : 


Sub ExplorerDossier(Repertoire As String)
    
    Dim FSO, DossierRacine, FichiersContenus, DossiersContenus, FichierEnCours, DossierEnCours, FichierTemp
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set DossierRacine = FSO.GetFolder(Repertoire)
    Set FichiersContenus = DossierRacine.Files
    Set DossiersContenus = DossierRacine.SubFolders
    
    'ecrire les fichier du repertoire ouvert
    On Error GoTo GestionErreur
    For Each FichierEnCours In FichiersContenus
        
        'si l'arret est demande on sort de la procedure
        If ArretDemande = True Then Exit Sub
        
        If AttributsValides(FichierEnCours.Attributes) = True And ExtensionValides(FSO.GetExtensionName(FichierEnCours.Path)) = True Then
            
            'compte le nombre de fichiers
            NbFichiers = NbFichiers + 1
            
            'si trop de fichiers alors on les ecrit dans une variable temporaire
            If Int(NbFichiers / 100) = NbFichiers / 100 Then
                
                ListeTemp = ListeTemp & Liste
                Liste = ""
                
                'ecrite le nombre de fichier dans un controle
                If form_Option.opt_Francais.Value = True Then _
                lbl_FichiersListes.Caption = NbFichiers & " fichiers listés," & Chr(13) & "dont " & NbFichiersNonPermis & " fichier(s) inaccessible(s)."
                If form_Option.opt_English.Value = True Then _
                lbl_FichiersListes.Caption = NbFichiers & " files printed," & Chr(13) & "with " & NbFichiersNonPermis & " file(s) unauthorized."
                
            End If
            
            'ecrit le nom du fichier dans la liste
            Liste = Liste & Chr(13) & Chr(10) & _
            RepetCarac(Espace, Profondeur) & FichierPref & FichierEnCours.Name & FichierSuf
            
        End If
        
        DoEvents
        
    Next
    
    'si la profondeur ne depasse pas la limite autorise et
    If Profondeur < ProfondeurMaxi Then
        
        'on augmente la profondeur
        Profondeur = Profondeur + 1
        
        For Each DossierEnCours In DossiersContenus
            
            'si l'arret est demande on sort de la procedure
            If ArretDemande = True Then Exit Sub
            
            If AttributsValides(DossierEnCours.Attributes - 16) = True Then
                                
                'ecrit a la suite dans la liste le nom du dossier ouvert
                Liste = Liste & Chr(13) & Chr(10) & _
                RepetCarac(Espace, Profondeur - 1) & DosOuvPref & DossierEnCours.Name & DosOuvSuf
                
                'ecrit dans un controle le chemin du dossier actuellement ouvert
                lbl_DossierEnCours.Caption = DossierEnCours.Path
                
                'compte le nombre de dossier trouves
                NbDossiers = NbDossiers + 1
                
                'ecrit le nombre de dossier trouves dans un controle
                If form_Option.opt_Francais.Value = True Then _
                lbl_DossiersListes.Caption = NbDossiers & " dossiers listés," & Chr(13) & "dont " & NbDossiersSurface & " dossiers de surface."
                If form_Option.opt_English.Value = True Then _
                lbl_DossiersListes.Caption = NbDossiers & " folders printed," & Chr(13) & "with " & NbDossiersSurface & " surface folders."
                
                'explore le sous dossier indexe par NoDossier
                Call ExplorerDossier(DossierEnCours.Path)
                
            End If
            
            DoEvents
            
        Next
        
        'on diminue d'une profondeur
        Profondeur = Profondeur - 1
        
    End If
    
    'si l'option lister les dossiers de surface est valide
    If Profondeur = ProfondeurMaxi And chk_ListerDossierSurf.Value = 1 Then
        For Each DossierEnCours In DossiersContenus
            
            'si l'arret est demande on sort de la procedure
            If ArretDemande = True Then Exit Sub
            
            If AttributsValides(DossierEnCours.Attributes - 16) = True Then
                
                'ecrit a la suite dans la liste le nom du dossier de surface
                Liste = Liste & Chr(13) & Chr(10) & _
                RepetCarac(Espace, Profondeur) & DosSurfPref & DossierEnCours.Name & DosSurfSuf
                
                'compte le nombre de dossiers et dossiers de surface
                NbDossiers = NbDossiers + 1
                NbDossiersSurface = NbDossiersSurface + 1
                
                'ecrit le nombre de ossiers dans un controle
                If form_Option.opt_Francais.Value = True Then _
                lbl_DossiersListes.Caption = NbDossiers & " dossiers listés," & Chr(13) & "dont " & NbDossiersSurface & " dossiers de surface."
                If form_Option.opt_English.Value = True Then _
                lbl_DossiersListes.Caption = NbDossiers & " folders printed," & Chr(13) & "with " & NbDossiersSurface & " surface folders."
                
            End If
            
            DoEvents
            
        Next
    End If
    
    Exit Sub
    
GestionErreur:
    If Err.Number = 70 Then NbFichiersNonPermis = NbFichiersNonPermis + 1
    Resume Next
End Sub

Conclusion :


Pas de bug connu jusque là. En théorie si vous avez visual basic 6, il ne devrait pa manquer de dll.
Dans la liste vous pouvez choisir :
-les attributs des fichiers et dossiers (caché, système, en lecture seule,...)
-les extensions des fichiers (aucune extension choisie = aucun filtre : tous les fichiers seront listés)
-la syntaxe d'écriture dans la liste (modification de la chaine de caractéres de vant et aprés chaque dossier ou fichiers,...), en cliquant sur le boutons plus d'options.
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_pingouin84k)