Binaryworld - GetFilesInfo - Read all the information about all the files or subdire ... [ VB -> Files & Folder ]

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