GetFilesInfo - Read all the information about all the files or subdires in a given path

Option Explicit

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
    (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As _
    Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFILETIME As _
    FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFILETIME As _
    FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _
    Any, source As Any, ByVal bytes As Long)

Const MAX_PATH = 260

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_TEMPORARY = &H100

' Returns a bi-dimensional variant array containing the files (or directories)
' located in the specified path
'
' the format of the returned array is as follows
'   arr(0, n) = the name of the N-th file (String)
'   arr(1, n) = file length (Double)
'   arr(2, n) = creation time (Date)
'   arr(3, n) = last access time (Date)
'   arr(4, n) = last write time (Date)
'   arr(5, n) = attributes (string)
'           can contain one or more of the following characters
'           (A)rchive, (R)eadonly, (S)ystem, (H)idden, (C)ompressed, (T)emporary
'   arr(6, n) = short 8.3 filename (string)
'
' the Path argument can contain wildcards, e.g. "C:\*.doc")

Function GetFilesInfo(ByVal Path As String, Optional ByVal IncludeDirs As _
    Boolean) As Variant()
    Dim lRet As Long
    Dim handle As Long
    Dim FindData As WIN32_FIND_DATA
    Dim FileName As String
    Dim FileCount As Long
    Dim ok As Boolean
    Dim tmpCurrency As Currency
    Dim attributes As String
    Dim ft As FILETIME
    Dim st As SYSTEMTIME
    
    ReDim res(6, 0) As Variant
    
    ' start the searching, exit if no file matches the spec
    handle = FindFirstFile(Path, FindData)
    If handle < 0 Then
        GetFilesInfo = res()
        Exit Function
    End If
        
    Do
        ' get this entry's name
        FileName = Left$(FindData.cFileName, InStr(FindData.cFileName, _
            vbNullChar) - 1)
        
        If (FindData.dwFileAttributes And vbDirectory) = 0 Then
            ' this is a file
            ok = Not IncludeDirs
        ElseIf FileName <> "." And FileName <> ".." Then
            ' this is a directory, but not a ./.. entry
            ok = IncludeDirs
        Else
            ' this is a ./.. entry
            ok = False
        End If
            
        If ok Then
            ' add this entry to the result
            FileCount = FileCount + 1
            If FileCount > UBound(res, 2) Then
                ' make room in the array if necessary
                ReDim Preserve res(6, FileCount + 100) As Variant
            End If
            ' move data into the array
            res(0, FileCount) = FileName
            ' get the size as a currency value and convert to a double
            CopyMemory tmpCurrency, FindData.nFileSizeLow, 4
            CopyMemory ByVal VarPtr(tmpCurrency) + 4, FindData.nFileSizeHigh, 4
            res(1, FileCount) = CDbl(tmpCurrency) * 10000#
            ' convert creation time
            FileTimeToLocalFileTime FindData.ftCreationTime, ft
            FileTimeToSystemTime ft, st
            res(2, FileCount) = DateSerial(st.wYear, st.wMonth, _
                st.wDay) + TimeSerial(st.wHour, st.wMinute, _
                st.wSecond) + (st.wMilliseconds / 86400000)
            ' convert last access time
            FileTimeToLocalFileTime FindData.ftLastAccessTime, ft
            FileTimeToSystemTime ft, st
            res(3, FileCount) = DateSerial(st.wYear, st.wMonth, _
                st.wDay) + TimeSerial(st.wHour, st.wMinute, _
                st.wSecond) + (st.wMilliseconds / 86400000)
            ' convert last write time
            FileTimeToLocalFileTime FindData.ftLastWriteTime, ft
            FileTimeToSystemTime ft, st
            res(4, FileCount) = DateSerial(st.wYear, st.wMonth, _
                st.wDay) + TimeSerial(st.wHour, st.wMinute, _
                st.wSecond) + (st.wMilliseconds / 86400000)
            ' convert attributes into a readable string
            attributes = Space$(6)
            If FindData.dwFileAttributes And vbArchive Then Mid$(attributes, 1, _
                1) = "A"
            If FindData.dwFileAttributes And vbReadOnly Then Mid$(attributes, 2, _
                1) = "R"
            If FindData.dwFileAttributes And vbHidden Then Mid$(attributes, 3, _
                1) = "H"
            If FindData.dwFileAttributes And vbSystem Then Mid$(attributes, 4, _
                1) = "S"
            If FindData.dwFileAttributes And FILE_ATTRIBUTE_COMPRESSED Then _
                Mid$(attributes, 5, 1) = "C"
            If FindData.dwFileAttributes And FILE_ATTRIBUTE_TEMPORARY Then Mid$ _
                (attributes, 6, 1) = "T"
            res(5, FileCount) = attributes
            ' get short 8.3 filename
            res(6, FileCount) = Left$(FindData.cAlternate, _
                InStr(FindData.cAlternate, vbNullChar) - 1)
        End If
        ' read the next file, returns zero when there are no more files
        lRet = FindNextFile(handle, FindData)
    Loop While lRet

    ' stop enumeration
    FindClose handle
    
    ' discard unused array items and return to caller
    ReDim Preserve res(6, 0 To FileCount) As Variant
    GetFilesInfo = res
End Function