Vb6 : tout en un, une fonction dir() améliorée, avec retour d'erreurs, utilisation des wildcards et des filtres d'attributs

Commenter

Contenu du snippet

Tester la présence d'un fichier, ou d'un groupe de fichiers, d'un sous-répertoire ou groupe de sous-répertoires,
Obtenir une liste de noms de fichiers présents dans un répertoire, en utilisant les wilcards
Obtenir le nombre de fichiers ou répertoires
Obtenir la taille totale en octets d'un fichier ou d'un groupe de fichiers

C'est sans prétentions, bien pratique, et ne nécessite aucun objet... ;o)

Source / Exemple : 


Public Function FCount(FichiersRecherches As String, Optional Filtres As Integer = 7, Optional GiveTotalSize As Integer = False, Optional bGiveStringOfFiles As Integer = False) As Variant

    Dim NFc As Double
    Dim a As String
    Dim B As String
    Dim totalSize As Double
    Dim getPath As String
    Dim strStringOfFiles As String
    
    If GiveTotalSize = True And bGiveStringOfFiles = True Then
        FCount = -1
        Exit Function
    End If
    
    Do Until InStr(Len(getPath) + 1, FichiersRecherches, "\") = 0
        getPath = Left(FichiersRecherches, InStr(Len(getPath) + 1, FichiersRecherches, "\"))
    Loop
    
    If GiveTotalSize Then
        If (Filtres And 16) = 16 Then
            FCount = 0
            Exit Function
        End If
    End If
    
    NFc = 0
    On Local Error GoTo ErrFCount
    
    a = Dir(FichiersRecherches, Filtres)
    If a = "" Then GoTo FinFCount
    
    If GiveTotalSize Then
        NFc = CDbl(FileLen(getPath & a))
    ElseIf bGiveStringOfFiles Then
        If Filtres = vbDirectory Then
            If (GetAttr(getPath & a) And vbDirectory) = vbDirectory Then
                strStringOfFiles = strStringOfFiles & IIf(strStringOfFiles > "", vbCr, "") & a
            End If
        Else
            strStringOfFiles = strStringOfFiles & IIf(strStringOfFiles > "", vbCr, "") & a
        End If
    Else
        NFc = 1
    End If
    Do
        B = Dir
        If B = "" Then Exit Do
        If GiveTotalSize Then
            NFc = NFc + CDbl(FileLen(getPath & B))
        ElseIf bGiveStringOfFiles Then
            If Filtres = vbDirectory Then
                If (GetAttr(getPath & B) And vbDirectory) = vbDirectory Then
                    strStringOfFiles = strStringOfFiles & vbCr & B
                End If
            Else
                strStringOfFiles = strStringOfFiles & vbCr & B
            End If
            
        Else
            NFc = NFc + 1
        End If
    Loop
    
FinFCount:

    If bGiveStringOfFiles Then
        FCount = strStringOfFiles
    Else
        FCount = NFc
    End If
    Exit Function
    
ErrFCount:
    If GiveTotalSize Then
        NFc = 0
    ElseIf bGiveStringOfFiles Then
        strStringOfFiles = ""
    Else
        NFc = -1 * Err
    End If
    Resume FinFCount

End Function

Conclusion :


FCount retourne une valeur de type Variant

Paramètres :
1) Obligatoire : FichiersRecherches as String : 1 Nom de fichier avec ou sans wildcards, avec un chemin d'accès sans WildCards
2) Optionnel : Filtres As Integer : Type de fichier(s) recherché(s) : vbNormal (par défaut), vbDirectory, vbHidden, etc...
3) Optionnel : GiveTotalSize as Integer : True ou False (défaut) : FCount renvoit la taille du fichier ou du groupe de fichiers recherchés
4) Optionnel : bGiveStringOfFiles as Integer : True ou False (défaut) : FCount renvoit une chaîne de caractères contenant les noms de fichiers trouvés, séparés par vbCr (chr(13))

Note : GiveTotalSize et bGiveStringOfFiles ne peuvent pas être à True en même temps...

Exemples d'utilisation :

' Tester la présence d'un fichier, sans se préoccuper des erreurs (chemin d'accès invalide, ou disque absent, par exemple)
' Ça marche aussi en remplaçant "A:MonFichier" par "A:MesDocsWord*.doc"
Select Case FCount("A:MonFichier")
Case 0
' "MonFichier" n'est pas sur la disquette, ou mais il y a bien une disquette dans le lecteur
Case Is > 0
' "MonFichier" est bien sur la disquette
' ou il y a 1 ou plusieurs fichiers "MesDocsWord*.doc" sur ma disquette (ou dans le répertoire indiqué)
Case Is < 0
' "MonFichier" est absent de la disquette, mais il s'est produit une erreur
' FCount retourne alors une valeur négative correspondant au code erreur VB (multiplié par -1)
End Select

' Obtenir une liste de noms de fichiers présents dans un répertoire, avec des wildcards
Dim Liste() as String
Liste = Split( FCount("A:MesDocs*.DOC"), , ,True), vbCr)
' Liste(0) contient un nom de fichier
' Liste(1) Contient le nom de fichier suivant, etc...
'
' Si Liste(0) = "", il n'y a pas de fichier

' Obtenir la taille totale en octets, d'un fichier ou d'un groupe de fichiers
Dim Taille as Double
Taille = FCount( "A:*.DOC", , True)

Etc...

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_swic)