Листинг 3.98. Просмотр содержимого папки с указанием полного пути к файлам
' Объявление API-функции для отображения стандартного окна _
просмотра папок
Declare Function SHBrowseForFolder Lib «shell32.dll» _
Alias «SHBrowseForFolderA» (lpBrowseInfo As BROWSEINFO) As
Long
' Объявление API-функции для преобразования данных, возвращаемых _
функцией SHBrowseForFolder, в строку
Declare Function SHGetPathFromIDList Lib «shell32.dll» _
Alias «SHGetPathFromIDListA» (ByVal pidl As Long, ByVal _
pszPath As String) As Long
' Структура используется функцией SHBrowseForFolder
Type BROWSEINFO
hwndOwner As Long ' Родительское окно (для диалога)
pidlRoot As Long ' Корневая папка для просмотра
strDisplayName As String
strTitle As String ' Заголовок окна
ulFlags As Long ' Флаги для окна
' Следующие три параметра в VBA не используются
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub BrowseFolder1()
Dim strPath As String ' Папка, список файлов которой выводится
Dim strFile As String
Dim intRow As Long ' Текущая строка таблицы
' Выбор папки
strPath = dhBrowseForFolder()
If strPath = "" Then Exit Sub
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
' Оформление заголовка отчета
ActiveSheet.Cells.ClearContents
ActiveSheet.Cells(1, 1) = «Имя файла»
ActiveSheet.Cells(1, 2) = «Размер»
ActiveSheet.Cells(1, 3) = «Дата/время»
ActiveSheet.Range(«A1:C1»).Font.Bold = True
' Просмотр объектов в папке...
' Первый объект папки
strFile = Dir(strPath, 7)
intRow = 2
Do While strFile <> ""
' Запись в столбец "A" имени файла
ActiveSheet.Cells(intRow, 1) = strPath & strFile
' Запись в столбец "B" размера файла
ActiveSheet.Cells(intRow, 2) = FileLen(strPath & strFile)
' Запись в столбец "C" времени изменения файла
ActiveSheet.Cells(intRow, 3) = FileDateTime(strPath &
strFile)
' Следующий объект папки
strFile = Dir
intRow = intRow + 1
Loop
End Sub
Function dhBrowseForFolder() As String
Dim biBrowse As BROWSEINFO
Dim strPath As String
Dim lngResult As Long
Dim intLen As Integer
' Заполнение полей структуры BROWSEINFO
' Корневая папка – Рабочий стол
biBrowse.pidlRoot = 0&
' Заголовок окна
biBrowse.strTitle = «Выбор папки»
' Тип возвращаемой папки
biBrowse.ulFlags = &H1
' Выводим стандартное окно просмотра папок
lngResult = SHBrowseForFolder(biBrowse)
' Обработка результата работы окна
If lngResult Then
' Получение пути (по возвращенным данным)
strPath = Space$(512)
If SHGetPathFromIDList(ByVal lngResult, ByVal strPath)
Then
' Строка пути заканчивается символом Chr(0)
