Option Explicit
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
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
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Sub InterateObject(Source As String)
Dim objName As String
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
Cont = True
hSearch = FindFirstFile(Source & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
objName = Left(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
If Not (objName = "." Or objName = "..") Then
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
List1.AddItem Source & objName
Else
InterateObject Source & objName & "\"
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
End Sub
Private Sub Command1_Click()
Dim dblTimer As Double
dblTimer = Timer
List1.Clear
InterateObject "C:\"
Debug.Print Round(Timer - dblTimer, 2)
End Sub
это самый быстрый вариант, добавить поиск по маске - домашнее задание
А как оно на самом деле - Х.З. !