Getting A List Of File Names Using VBA

Category: VBA Functions | [Item URL]

If your macro needs to present a list of files for the user to choose from, the easiest approach is to use the GetOpenFileName method of the Application object. For example, the code below displays the standard File Open dialog box. If the user selects a file, the filename is stored in SelectedFile; if the user clicks Cancel, SelectedFile is equal to False.

 Filter = "Excel files (*.xls), *.xls"
 Caption = "Select a File"
 SelectedFile = Application.GetOpenFilename(Filter, , Caption)

In some cases, however, you may want to get a list of all files in a particular directory. The VBA function below (GetFileList) accepts a DOS path and filespec as its argument, and returns a variant array that contains all of the filenames in that directory. If no matching files are found, the function returns False.

Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
    
    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
    
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
NoFilesFound:
    GetFileList = False
End Function

The subroutine listed below demonstrates how to use this function. In this example, the filespec is passed to the GetFileList function and the result is stored in x. If x is an array, it means that matching files were found. A message box displays the number of files and the filenames are copied to column A in Sheet1. If x is not an array, it means that no matching files were found.

Sub test()
    Dim p As String, x As Variant

    p = "c:/msoffice/excel/library/*.xls"
    x = GetFileList(p)
    Select Case IsArray(x)
        Case True 'files found
            MsgBox UBound(x)
            Sheets("Sheet1").Range("A:A").Clear
            For i = LBound(x) To UBound(x)
                Sheets("Sheet1").Cells(i, 1).Value = x(i)
            Next i
        Case False 'no files found
            MsgBox "No matching files"
    End Select
End Sub