Option
Explicit
Private
Declare
PtrSafe
Function
FindFirstFile
Lib
"kernel32"
Alias
"FindFirstFileA"
(
ByVal
lpFileName
As
String
, lpFindFileData
As
WIN32_FIND_DATA)
As
LongPtr
Private
Declare
PtrSafe
Function
FindNextFile
Lib
"kernel32"
Alias
"FindNextFileA"
(
ByVal
hFindFile
As
LongPtr, lpFindFileData
As
WIN32_FIND_DATA)
As
LongPtr
Private
Declare
PtrSafe
Function
FindClose
Lib
"kernel32"
(
ByVal
hFindFile
As
LongPtr)
As
Long
Private
Type FILETIME
dwLowDateTime
As
Long
dwHighDateTime
As
Long
End
Type
Const
MAX_PATH
As
Long
= 260&
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
Const
FILE_ATTRIBUTE_ARCHIVE
As
Long
= &H20&
Const
FILE_ATTRIBUTE_COMPRESSED
As
Long
= &H800&
Const
FILE_ATTRIBUTE_DIRECTORY
As
Long
= &H10&
Const
FILE_ATTRIBUTE_HIDDEN
As
Long
= &H2&
Const
FILE_ATTRIBUTE_NORMAL
As
Long
= &H80&
Const
FILE_ATTRIBUTE_READONLY
As
Long
= &H1&
Const
FILE_ATTRIBUTE_SYSTEM
As
Long
= &H4&
Const
FILE_ATTRIBUTE_TEMPORARY
As
Long
= &H100&
Public
Function
GetFiles(
ByVal
Path
As
String
,
ByVal
FileExtensionFilter
As
String
,
ByRef
Files
As
VBA.Collection)
As
Long
If
Right$(Path, 1) <>
"\" Then Path = Path & "
\"
If
FileExtensionFilter =
""
Then
Exit
Function
If
Files
Is
Nothing
Then
Set
Files =
New
VBA.Collection
Dim
fd
As
WIN32_FIND_DATA
Dim
strFile
As
String
Dim
hFile
As
LongPtr
hFile = FindFirstFile(Path &
"*.*"
, fd)
If
hFile = 0
Then
Exit
Function
Do
strFile = Left$(fd.cFileName, InStr(fd.cFileName, vbNullChar) - 1)
If
(fd.dwFileAttributes
And
FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY
Then
If
strFile <>
"."
And
strFile <>
".."
Then
Call
GetFiles(Path & strFile, FileExtensionFilter, Files)
End
If
Else
If
strFile
Like
FileExtensionFilter
Then
Call
Files.Add(Path & strFile)
End
If
End
If
Loop
While
FindNextFile(hFile, fd)
Call
FindClose(hFile)
GetFiles = Files.Count
End
Function