Public Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Public Const MAX_PATH As Long = 260
Public Const INVALID_HANDLE_VALUE As Long = &HFFFFFFFF '((Handle) - 1)
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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
Public 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
AllFiles = 1
FileOnly = 2
DirectoryOnly = 3
End Enum
Public Enum RESULT_OPTION
roNameOnly = 0
roNameAndSize = 1
roAll = 2
End Enum
Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal lpString As String) As Long
Private Declare Function lstrcpyW Lib "kernel32.dll" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
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
Public Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32.dll" (ByVal hFindFile As Long) As Long
Public Declare Function FindFirstFileW Lib "kernel32.dll" (ByVal lpFileName As String, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFileW Lib "kernel32.dll" (ByVal hFindFile As Long, ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private 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, SysTime.wSecond)
End If
End Function
Private Function FindMatchedFilesW(Arr, ByVal DirStart As String, ByVal Filename As String, Optional ByVal res_option As RESULT_OPTION = roNameOnly, Optional ByVal OneOnly As Boolean = False, _
Optional ByVal SubDir As Boolean = True, Optional ByVal find_option As FIND_FILE_OPTION = AllFiles)
' DirStart: unicode. Nếu lấy từ sheet hoặc nhập thẳng thì dùng CONVERT - StrConv(..., vbUnicode)
' Filename: Lấy từ sheet hoặc nhập thẳng
' res_option = 1 (roNameOnly) - chỉ lấy về tên, 1 (roNameAndSize) - lấy về tên và độ lớn, 2 (roAll) - lấy về tên, độ lớn và ngày sửa
' Arr: mảng chứa kết quả trả về.
' OneOnly: nếu FALSE thi trả về tất cả tìm thấy, nếu TRUE thì trả về kết quả đầu tiên
' SubDir: nếu TRUE thì tim cả trong các thư mục con
' find_option = 1 (AllFiles) - tìm tập tin và thư mục, 2 (FileOnly) - chỉ tìm tập tin, 3 (DirectoryOnly) - chỉ tìm thư mục
Dim FindData As WIN32_FIND_DATA
Dim FindHandle As Long
Dim validDir As Boolean
Dim fName As String, s_len As Long
Dim s As String
If Right(StrConv(DirStart, vbFromUnicode), 1) <> "\" Then DirStart = DirStart & "\" & vbNullChar
FindHandle = FindFirstFileW(DirStart & "*" & vbNullChar, FindData)
If FindHandle <> INVALID_HANDLE_VALUE Then
Do
s_len = lstrlenW(FindData.cFileName)
fName = String$(s_len * 2, vbNullChar)
lstrcpyW fName, FindData.cFileName
validDir = ((FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY) And _
(Left(fName, 1) <> ".") And (UCase(fName) <> "RECYCLE") And (UCase(fName) <> "RECYCLER")
If (validDir And find_option <> FileOnly) Or _
(((FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) And find_option <> DirectoryOnly) Then
s = StrConv(fName, vbFromUnicode)
If s Like Filename Then
If IsEmpty(Arr) Then
ReDim Arr(0 To res_option)
Else
ReDim Preserve Arr(0 To UBound(Arr) + res_option + 1)
End If
Arr(UBound(Arr) - res_option) = StrConv(DirStart, vbFromUnicode) & s
If res_option > 0 Then
Arr(UBound(Arr) - res_option + 1) = FindData.nFileSizeLow
If res_option = 2 Then Arr(UBound(Arr)) = UTCtoSysTime(FindData.ftLastWriteTime)
End If
If OneOnly Then Exit Do
End If
End If
If validDir And SubDir Then
FindMatchedFilesW = FindMatchedFilesW(Arr, DirStart & fName, Filename, res_option, OneOnly, SubDir, find_option)
End If
Loop Until FindNextFileW(FindHandle, FindData) = 0
End If
If FindHandle <> INVALID_HANDLE_VALUE Then FindClose (FindHandle)
End Function
Public Function FindMatchedFiles(ByVal DirStart As String, ByVal Filename As String, Optional ByVal res_option As RESULT_OPTION = roNameOnly, Optional ByVal OneOnly As Boolean = False, _
Optional ByVal SubDir As Boolean = True, Optional ByVal find_option As FIND_FILE_OPTION = AllFiles)
' vd.cách gọi:
' Dim Arr
' Arr = FindMatchedFiles(StrConv(ActiveSheet.Range("H1").Value, vbUnicode), "*", roAll)
' Range("A1").Resize(UBound(Arr) + 1, UBound(Arr, 2) + 1).Value = Arr
'---------
' vd.cách gọi:
' Dim Arr
' Arr = FindMatchedFiles(StrConv(ActiveSheet.Range("H1").Value, vbUnicode), "*2?8*", roAll)
' Range("A1").Resize(UBound(Arr) + 1, UBound(Arr, 2) + 1).Value = Arr
Dim Arr, index As Long, r As Long, c As Long
FindMatchedFilesW Arr, DirStart, Filename, res_option, OneOnly, SubDir, find_option
ReDim resArr(0 To (UBound(Arr) + 1) \ (res_option + 1) - 1, 0 To res_option) As String
For r = 0 To UBound(resArr, 1)
k = (res_option + 1) * r
For c = 0 To res_option
resArr(r, c) = Arr(k + c)
Next c
Next r
FindMatchedFiles = resArr
End Function
