Excel. Трюки и эффекты

Листинг 3.97. Просмотр содержимого папки

' Объявление 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 BrowseFolder()

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) = 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)

intLen = InStr(strPath, Chr$(0))

' Выделение и возврат пути

dhBrowseForFolder = Left(strPath, intLen – 1)

Else

' Не удалось получить путь

dhBrowseForFolder = ""

End If

Else

' Пользователь нажал кнопку «Отмена»

dhBrowseForFolder = ""

End If

End Function