VB and VBA Users Source Code: Obtain the files stored in a directory
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Obtain the files stored in a directory
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, January 16, 2001
Hits:
753
Category:
Files/Directories/IO
Article:
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 'Author : Andrew Baker 'Date : 04/12/2000 16:45 'Notes : 'Revisions : 'Assumptions : 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 'Author : Andrew Baker 'Date : 25/11/2000 03:33 'Notes : 'Revisions : 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 'Author : Andrew Baker 'Date : 17/08/2000 'Notes : 'Revisions : 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
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
