16
Декабрь
2008
Как получить имена всех файлов даже во вложенных папках?
Как получить имена всех файлов даже во вложенных папках?
Option Explicit
Private Sub Form_Load()
'Это займет продолжительное время так что не пугайтесь
'Укажите путь, для поиска файлов
InterateObject ("C:\")
End Sub
Модуль:
Option Explicit
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -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, _
ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, _
ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Sub InterateObject(ByRef 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, vbNullChar) - 1)
If Not (objName = "." Or objName = "..") Then
If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
Form1.List1.AddItem Source & objName
Else
InterateObject Source & objName & "\"
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
End Sub