Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = &HFFFFFFFF '((Handle) - 1)
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
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 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
Public Enum FIND_FILE_OPTION
FileOnly = 1
DirectoryOnly = 2
AllFiles = 3
End Enum
Public Enum FIND_RESULT_OPTION
frName = 1
frNameSize = 3
frNameDate = 5
frNameSizeDate = 7
End Enum
Private Declare Function FileTimeToLocalFileTime Lib "kernel32.dll" (ByRef lpFileTime As FILETIME, ByRef lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32.dll" (ByRef lpFileTime As FILETIME, ByRef lpSystemTime As SYSTEMTIME) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFileW Lib "kernel32.dll" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFileW Lib "kernel32.dll" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Const recycle = "RECYCLE"
Function UTCtoSysTime(fTime As FILETIME) As String
Dim LocalFileTime As FILETIME, SysTime As SYSTEMTIME
If ((fTime.dwLowDateTime <> 0) Or (fTime.dwHighDateTime <> 0)) And _
FileTimeToLocalFileTime(fTime, LocalFileTime) And FileTimeToSystemTime(LocalFileTime, SysTime) Then
UTCtoSysTime = DateSerial(SysTime.wYear, SysTime.wMonth, SysTime.wDay) & " " _
& TimeSerial(SysTime.wHour, SysTime.wMinute, 0)
End If
End Function
Sub FindMatchedFilesExtW(arr, DirSize As Double, ByVal DirStart As String, ByVal filename As String, Optional ByVal res_option As FIND_RESULT_OPTION = frName, _
Optional ByVal SubDir As Boolean = True, Optional ByVal find_option As FIND_FILE_OPTION = FileOnly)
' Arr: maŇng chýěa kęět quaŇ traŇ vęĚ laĚ maŇng 2 chięĚu
' SubDir: nęěu TRUE thiĚ tim caŇ trong caěc thý muňc con
' find_option = 3 (AllFiles) - tiĚm tâňp tin vaĚ thý muňc, 1 (FileOnly) - chiŇ tiĚm tâňp tin, 2 (DirectoryOnly) - chiŇ tiĚm thý muňc
' DirSize chi dung cho vai th, vd. filename = "*", find_option = FileOnly, SubDir = True
' ----------------------------------------
' vd. caěch duĚng
' FindMatchedFilesExtW arr, size, "C:\", "*", frNameSizeDate, , FileOnly
' Application.ScreenUpdating = False
' Range("A1").Resize(UBound(arr) + 1, UBound(arr, 2) + 1).Value = arr
' Application.ScreenUpdating = True
Dim FindData As WIN32_FIND_DATA
Dim FindHandle As Long
Dim validDir As Boolean, IsFile As Boolean, doAdd As Boolean
Dim fName As String, k As Long, r As Long, c As Long, dSize As Double, size As Long
Static level As Long
On Error Resume Next
If Right(DirStart, 1) <> "\" Then DirStart = DirStart & "\"
[B][COLOR=#ff0000]If Not SubDir And (find_option = FileOnly) Then [/COLOR][/B][COLOR=#0000ff]<--- thay cho [/COLOR][COLOR=#ff0000]fName = StrConv(DirStart & filename, vbUnicode)[/COLOR]
[B][COLOR=#ff0000] fName = StrConv(DirStart & filename, vbUnicode)
Else
fName = StrConv(DirStart & "*", vbUnicode)
End If[/COLOR][/B]
FindHandle = FindFirstFileW(fName, FindData)
If FindHandle <> INVALID_HANDLE_VALUE Then
If res_option = frName Then
size = 0
ElseIf res_option = frNameSizeDate Then
size = 2
Else
size = 1
End If
doAdd = SubDir Or (level = 0)
Do
fName = StrConv(FindData.cFileName, vbFromUnicode)
k = InStr(1, fName, vbNullChar)
fName = Left(fName, k - 1)
validDir = (FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY
IsFile = Not validDir
If IsFile Then DirSize = DirSize + FindData.nFileSizeLow
If validDir Then validDir = (Left(fName, 1) <> ".") And (InStr(1, fName, recycle, vbTextCompare) <> 1)
If validDir Then
If SubDir Or ((find_option > 1) And ((res_option And 2) = 2)) Then
level = level + 1
dSize = 0
FindMatchedFilesExtW arr, dSize, DirStart & fName, filename, res_option, SubDir, find_option
level = level - 1
DirSize = DirSize + dSize
End If
End If
[B][COLOR=#ff0000]If fName Like filename Then[/COLOR][/B] [COLOR=#0000ff]<--- them[/COLOR]
If doAdd And ((validDir And (find_option > 1)) Or (IsFile And (find_option <> 2))) Then
If IsEmpty(arr) Then
ReDim arr(0 To size)
Else
ReDim Preserve arr(0 To UBound(arr) + size + 1)
End If
arr(UBound(arr) - size) = DirStart & fName
If (res_option And 2) = 2 Then
If IsFile And (find_option <> 2) Then
arr(UBound(arr) - size + 1) = FindData.nFileSizeLow
Else
arr(UBound(arr) - size + 1) = dSize
End If
End If
If (res_option And 4) = 4 Then arr(UBound(arr)) = UTCtoSysTime(FindData.ftCreationTime)
End If
[B][COLOR=#ff0000]End If[/COLOR][/B] [COLOR=#0000ff]<--- them[/COLOR]
Loop Until FindNextFileW(FindHandle, FindData) = 0
FindClose (FindHandle)
End If
If level = 0 Then
ReDim resArr(0 To (UBound(arr) + 1) \ (size + 1) - 1, 0 To size) As String
For r = 0 To UBound(resArr)
k = (size + 1) * r
For c = 0 To size
resArr(r, c) = arr(k + c)
Next c
Next r
arr = resArr
End If
End Sub
Sub myTest()
Dim t As Double, arr, size As Double
Range("A:C").Clear
t = Timer
FindMatchedFilesExtW arr, size, "c:\", "*", frNameSizeDate, , FileOnly
If IsEmpty(arr) Then Exit Sub
Debug.Print "siwtom code: " & UBound(arr) + 1 & " files (or folders) found!", , Format(Timer - t, "0.0") & "s"
Debug.Print size
Application.ScreenUpdating = False
Range("A1").Resize(UBound(arr) + 1, UBound(arr, 2) + 1).Value = arr
Application.ScreenUpdating = True
End Sub
) ,Cứ nghĩ rằng 2 Thầy là người ngoài hành tinh thì đúng! ha ha ha!!!!!!!!!!!!!! 
