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

Option ExplicitPrivate Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _    (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As _    LongPrivate Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFILETIME As _    FILETIME, lpLocalFileTime As FILETIME) As LongPrivate Declare Function FileTimeToSystemTime Lib "kernel32" (lpFILETIME As _    FILETIME, lpSystemTime As SYSTEMTIME) As LongPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As _    Any, source As Any, ByVal bytes As Long)Const MAX_PATH = 260Private Type FILETIME    dwLowDateTime As Long    dwHighDateTime As LongEnd TypePrivate 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 * 14End TypePrivate 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 IntegerEnd TypeConst FILE_ATTRIBUTE_COMPRESSED = &H800Const 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 = resEnd Function

Share the Post:
Share on facebook
Share on twitter
Share on linkedin

Overview

Recent Articles: