• Home
 · 
• Files/File Controls/Input/Output
 · 
• Counting files or subdirs in a dir, get list of files or subdirs in a dir, get single or total file

Counting files or subdirs in a dir, get list of files or subdirs in a dir, get single or total file

Counting files or subdirs in a dir, get list of files or subdirs in a dir, get single or total filesize for a list of files in a dir, and so

Rate Counting files or subdirs in a dir, get list of files or subdirs in a dir, get single or total file

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'-------------------------------------------------------------------------------' Routine FCount
' Author : Christian BAY
' Mail : [email protected]
' Country : France
'-------------------------------------------------------------------------------
' Wishes :
'   Use this routine, and if you make it better, please mail me your new release.
'   Best regards
' -------------------------------------------------------------------------------------------
' Returns a value of variant type
'
' WildCards (*?) available in file and directory names
'
' Returns a value < 0 : an error occured. Value returned is Err.Number * -1
'
' Tasks :
'   Test if a file exists :                                         if FCount("C:\MyPath\TEST.TXT")>0 then...
'   Count how much files exist :                            lngNbOfFiles = FCount("C:\*.TXT")
'   Test if a directory exists :                                if FCount(strPath,vbdirectory)>0 then...
'   Test if a hidden directory exists :                      if FCount(strPath,vbDirectory + vbHidden)>0 then...
'   Get Total Size of files in a directory :                dblTotalSize = FCount("C:\MyPath\*.*",,true)          ' vbNormal + vbReadOnly + vbHidden + vbSystem files included
'   Get Total Size of .TXT files in a dir :                 dblTotalSize = FCount("C:\MyPath\*.TXT", vbNormal,,true)      ' vbReadOnly + vbHidden + vbSystem files excluded
'   Get a string of all filenames in a dir :                strMyFiles = FCount("C:\MyPath\*.*",,,true)     ' filenames are separated by vbCr
'   Get an array with .TXT filenames in a dir :      aMyArray = split(FCount("C:\MyPath\*.TXT",,,true), vbCr)
'
'   and so on...
' -------------------------------------------------------------------------------------------

Public Function FCount(ByVal FichiersRecherches As String, Optional ByVal Filtres As Integer = vbNormal + vbReadOnly + vbHidden + vbSystem, Optional ByVal GiveTotalSize As Integer = False, Optional ByVal 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
        ' can't ask 2 <> things at the same time !
        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
        ' routine doesn't give size for a directory
        If (Filtres And vbDirectory) = vbDirectory 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
        strStringOfFiles = strStringOfFiles & IIf(strStringOfFiles > "", vbCr, "") & a
    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
            strStringOfFiles = strStringOfFiles & vbCr & B
        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