Visual Basic > Files Directories Drives

Obtain the files stored in a directory

Obtain the files stored in a directory

To list all the files stored in a directory use the following FilesInDirectory routine. Note, a demonstration routine is can be found at the bottom of the post.

Option Explicit

'Purpose     :  Returns an array of the files contained in the specified directory
'Inputs      :  asFiles             See Outputs
'               sPath               The path to search
'               [sFilter]           If specified used to filter the results eg. "*.xls" for all Excel Workbooks
'Outputs     :  Returns True if an error occurred
'               asFiles             A string array (1 to n), where n is the number of files found in the specified directory


Function FilesInDirectory(asFiles() As String, ByVal sPath As String, Optional sFilter As String) As Boolean
    Dim lMatchingFiles As Long, sFileName As String, lArraySize As Long
    Const clIncrement As Long = 5000
    
    On Error GoTo ErrFailed
    If Right$(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If
    
    'Initialise Variables
    lArraySize = clIncrement
    ReDim asFiles(1 To clIncrement)
    
    If DirExists(sPath) Then
        sFileName = Dir$(sPath & sFilter)
        'Loop over the files in the directory
        Do While FileExists(sPath & sFileName)
            lMatchingFiles = lMatchingFiles + 1
            If lMatchingFiles > lArraySize Then
                'Enlarge the array
                lArraySize = lArraySize + clIncrement
                ReDim Preserve asFiles(1 To lArraySize)
            End If
            asFiles(lMatchingFiles) = sPath & sFileName
            sFileName = Dir$
        Loop
    End If
    
    If lMatchingFiles Then
        'Resize the output array
        ReDim Preserve asFiles(1 To lMatchingFiles)
    Else
        'Delete the array
        Erase asFiles
    End If
    
    Exit Function
ErrFailed:
    'Error occurred
    Debug.Print Err.Description
    FilesInDirectory = True
End Function


'Purpose     :  Checks if a file exists
'Inputs      :  sFilePathName                   The path and file name e.g. "C:\Autoexec.bat"
'Outputs     :  Returns True if the file exists


Function FileExists(sFilePathName As String) As Boolean
    On Error GoTo ExitFunction
    If Len(sFilePathName) Then
        If (GetAttr(sFilePathName) And vbDirectory) < 1 Then
            'File Exists
            FileExists = True
        End If
    End If
ExitFunction:
    On Error Goto 0
End Function


'Purpose   :    Check if a Path Exists
'Inputs    :    sPath           The path to check
'Outputs   :    Returns True if the path exists, False if it doesn't


Function DirExists(ByVal sPath As String) As Boolean
    If sPath <> ".." And sPath <> "." And sPath <> "\" And Len(sPath) Then
        If Right$(sPath, 1) <> "\" Then
            sPath = sPath & "\"
        End If
        On Error Resume Next
        DirExists = (GetAttr(sPath) And vbDirectory) > 0
        On Error GoTo 0
    End If
End Function

'Demonstration routine
Sub Test()
    Dim asFiles() As String, lThisFile As Long
    FilesInDirectory asFiles, "C:\", "*.dll"      'Return all the DLLs in C:\
    For lThisFile = 1 To UBound(asFiles)
        Debug.Print asFiles(lThisFile)
    Next
End Sub