Просмотр содержимого папки

В процессе работы может возникать необходимость просмотра содержимого той или иной папки (например, для поиска требуемого файла). Чтобы ускорить данный процесс и не запускать для этой цели Проводник, рекомендуется воспользоваться макросом, код которого приведен в листинге 3.97.

Листинг 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

Особенность этой программы – использование API-функций работы с объектами файловой системы Windows – SHBrowseForFolderи SHGetPathFromlDList. Первая функция отображает стандартное диалоговое окно просмотра дерева папок и возвращает целое значение, идентифицирующее выбранную папку (или О в случае отмены выбора). Вторая функция позволяет определить путь папки, идентифицируемой этим значением.

После написания данного кода в окне выбора макросов станет доступен макрос BrowseFolder. После его выполнения откроется окно Обзор папок, в котором по обычным правилам Windows следует указать путь к требуемой папке и нажать кнопку ОК. В результате на текущем рабочем листе будет сформирован перечень файлов, входящих в состав указанной папки (рис. 3.37).

Для каждой позиции данного списка в соответствующих столбцах указывается имя файла, его размер (в байтах), а также дата и время создания или последнего изменения.

Рис. 3.37. Список файлов

При необходимости можно формировать данный список с указанием полного пути к каждому файлу. В этом случае код макроса будет выглядеть следующим образом (листинг 3.98).

Листинг 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)

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

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

dhBrowseForFolder = Left(strPath, intLen – 1)

Else

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

dhBrowseForFolder = ""

End If

Else

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

dhBrowseForFolder = ""

End If

End Function

После написания данного кода в окне выбора макросов станет доступным макрос BrowseFolderl. Результат его выполнения показан на рис. 3.38.

Рис. 3.38. Список файлов суказанием пути

На рисунке видно, что для каждой позиции данного списка указывается полный путь к файлу.