CodeItBetter Programming Another VB Programming Blog

'File/Folder Handling - How to sort the files using its create date and time?
Option Explicit
 
'This module is used to sort the files using its create date and time.
'The functions will sort the files and store it in an array.
'Developed by Sriraman CS.

Private Type FileTime
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAborted As Boolean
    hNameMaps As Long
    sProgress As String
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
Private Const GENERIC_WRITE = &H40000000
Private Const OPEN_EXISTING = 3
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FileTime, _
    lpLastAccessTime As FileTime, lpLastWriteTime As FileTime) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FileTime, _
    lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FileTime, _
    lpLocalFileTime As FileTime) As Long
 
Dim strFileArray() As String
 
Sub Test()
    Dim icount As Integer
    Dim ss As String
    'Specify the file path
    'specify the optional file extension = "*.JPG"
    Call fnLoadArrFiles("D:\Temp\40290_Nema", "*.JPG")
    For icount = 1 To UBound(strFileArray)
        ss = ss & strFileArray(icount) & vbCrLf
    Next icount
    MsgBox ss
End Sub
 
Function fnLoadArrFiles(strFilePath As String, Optional strFileExt As String = "*.JPG") As String
    If Not Right(strFilePath, 1) = "\" Then strFilePath = strFilePath & "\"
 
    'retrieve the files from the given path and store it in an array.
    strFileArray() = GetFiles(strFilePath & strFileExt, strFilePath, vbNormal + vbHidden + vbSystem)
 
    'Sort the files by create date & time
    Call SortArrayDateTime(strFileArray)
 
End Function
 
Function GetFiles(filespec As String, filePath As String, Optional Attributes As VbFileAttribute) As String()
    Dim result() As String
    Dim filename As String, count As Long, path2 As String
    Const ALLOC_CHUNK = 50
    ReDim result(0 To ALLOC_CHUNK) As String
    filename = Dir$(filespec, Attributes)
    Do While Len(filename)
        count = count + 1
        If count > UBound(result) Then
            'Resize the result array if necessary.
            ReDim Preserve result(0 To count + ALLOC_CHUNK) As String
        End If
        result(count) = filePath & filename
        'Get ready for the next iteration.
        filename = Dir$
    Loop
    ' Trim the result array.
    ReDim Preserve result(0 To count) As String
    GetFiles = result
End Function
 
Function SortArrayDateTime(strArray)
    Dim icount As Integer
    Dim intCount As Integer
    Dim strNew As String
    Dim intNew As Integer
 
    For intCount = LBound(strArray) To UBound(strArray)
        strNew = strArray(intCount)
        intNew = intCount
        For icount = intCount + 1 To UBound(strArray)
            'if first is greater than orig then swap
            'If DateDiff("s", FileDateTime(strArray(iCount)), FileDateTime(strNew)) < 0 Then
            If CheckFileTime(CStr(strArray(icount)), strNew) = strArray(icount) Then
                strNew = strArray(icount)
                intNew = icount
            End If
        Next icount
        strArray(intNew) = strArray(intCount)
        strArray(intCount) = strNew
    Next intCount
End Function
 
Function CheckFileTime(strFile1 As String, strFile2 As String)
    'This function checks the file date and time of the given two files and returns the old file.
    Dim strTime1 As String
    Dim strTime2 As String
    Dim intMillSec1 As Integer
    Dim intMillSec2 As Integer
    Dim intPos As Integer
 
    strTime1 = Trim(Replace(FileDateTime(strFile1), "  ", " "))
    intPos = InStrRev(strTime1, "~")
    intMillSec1 = Val(Mid$(strTime1, intPos + 1, 3))
    strTime1 = Left(strTime1, intPos - 1)
 
    strTime2 = Trim(Replace(FileDateTime(strFile2), "  ", " "))
    intPos = InStrRev(strTime2, "~")
    intMillSec2 = Val(Mid$(strTime2, intPos + 1, 3))
    strTime2 = Left(strTime2, intPos - 1)
 
    Select Case DateDiff("s", CDate(strTime1), CDate(strTime2))
    Case Is > 0
        CheckFileTime = strFile1
    Case Is = 0
        If intMillSec2 >= intMillSec1 Then
            CheckFileTime = strFile1
        Else
            CheckFileTime = strFile2
        End If
    Case Else
        CheckFileTime = strFile2
    End Select
End Function
 
Function FileDateTime(strFileName As String)
    'This function returns create date and time of the given file.
    Dim lngHandle As Long, SHDirOp As SHFILEOPSTRUCT, lngLong As Long
    Dim Ft1 As FileTime, Ft2 As FileTime, SysTime As SYSTEMTIME
    'Open the file
    lngHandle = CreateFile(strFileName, GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, _
        OPEN_EXISTING, 0, 0)
    'Get the fil's time
    GetFileTime lngHandle, Ft1, Ft1, Ft2
    'Convert the file time to the local file time
    FileTimeToLocalFileTime Ft2, Ft1
    'Convert the file time to system file time
    FileTimeToSystemTime Ft1, SysTime
    FileDateTime = Str$(SysTime.wMonth) + "/" + LTrim(Str$(SysTime.wDay)) + "/" + LTrim(Str$(SysTime.wYear)) _
        + " " + Str$(SysTime.wHour) + ":" + LTrim(Str$(SysTime.wMinute)) + ":" + LTrim(Str$(SysTime.wSecond)) _
        + "~" + LTrim(Str$(SysTime.wMilliseconds))
    'Close the file
    CloseHandle lngHandle
End Function