Раз вопрос довольно часто поднимается, решил "слепить" примерчик. Конечно далеко не идеальный вариант. По хорошему нужно было бы собрать WSC компонент или класс модуль и добавить функционал. Но кому будет нужно, тот допилит, а для наглядности и простоты наверное так лучше.
Функция FilterFolderItems(oItems, ByVal Query) для сортировки и фильтрации переданных файлов или каталогов
oItems - Коллеция объектов Files или SubFolders, полученные через Scripting.FileSystemObject
Query - Запрос для отбора файлов или каталогов по необходимым критериям.
Ниже код с примерами и комментариями:
Option Explicit
Const TemporaryFolder = 2
Dim FileSystemObject, FolderPath, Folder, arrItems, oItem, strTmp
'Создаём объект для работы с файловой системой
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
'Получаем путь до каталога временных файлов (просто для примера).
FolderPath = FileSystemObject.GetSpecialFolder(TemporaryFolder)
'FolderPath = "C:\Windows\Web\Wallpaper"
'Получаем объектное представление каталога.
Set Folder = FileSystemObject.GetFolder(FolderPath)
'*** Пример 1 ***
arrItems = FilterFolderItems(Folder.SubFolders, "ORDER BY Name")
strTmp = "Сортировка каталогов по имени в прямом направлении" & String(2,vbCrlf)
'Перебираем возвращённые элементы
For Each oItem in arrItems
'Собираем в строку данные из массива
strTmp = strTmp & oItem.Name & vbCrlf
Next
'Выводим результат сортировки
MsgBox strTmp, 0, "Пример 1"
'*** Пример 2 ***
arrItems = FilterFolderItems(Folder.SubFolders, "ORDER BY DateLastModified DESC")
strTmp = "Сортировка каталогов по дате последнего изменения в обратном порядке" & String(2,vbCrlf)
'Перебираем возвращённые элементы
For Each oItem in arrItems
'Собираем в строку данные из массива
strTmp = strTmp & FormatDateTime(oItem.DateLastModified,2) & String(2,vbTab) & oItem.Name & vbCrlf
Next
'Выводим результат сортировки
MsgBox strTmp, 0, "Пример 2"
'*** Пример 3 ***
arrItems = FilterFolderItems(Folder.Files, "Size < 100 ORDER BY Size DESC, DateLastModified DESC")
strTmp = "Выборка файлов размером менее 100 байт и сортировка по дате последнего изменения в обратном порядке" & String(2,vbCrlf)
'Перебираем возвращённые элементы
For Each oItem in arrItems
'Собираем в строку данные из массива
strTmp = strTmp & FormatDateTime(oItem.DateLastModified,2) & String(2,vbTab) & oItem.Size & "Б" & String(2,vbTab) & oItem.Name & vbCrlf
Next
'Выводим результат сортировки
MsgBox strTmp, 0, "Пример 3"
'Функция сортировки и фильтрации переданных файлов или каталогов
'oItems - Элементы Files или SubFolders (коллекции файлов или подкаталогов), полученные от Scripting.FileSystemObject
'Query - Запрос для отбора файлов или каталогов по необходимым критериям.
Function FilterFolderItems(oItems, ByVal Query)
'Константы для метода GetRows
Const adGetRowsRest = -1 'Флаг Recordset-а для указания кол-ва возвращаемых строк
Const adBookmarkFirst = 1 'Флаг Recordset-а для возврата с первой записи
Const adIDispatch = 9
Const adDouble = 5
Const adVarChar = 200
Const adDate = 7
Dim oADORec, oItem
Set oADORec = CreateObject("ADODB.Recordset")
'Создаём поля под размещаемые элементы
With oADORec.Fields
.Append "Item", adIDispatch
.Append "Name", adVarChar, 255
.Append "Type", adVarChar, 255
.Append "Size", adDouble
.Append "DateCreated", adDate
.Append "DateLastAccessed", adDate
.Append "DateLastModified", adDate
End With
'Открываем рекордсет для добавления данных
oADORec.Open
'Заполняем переданными элементами
For Each oItem in oItems
oADORec.AddNew
oADORec("Item") = oItem
oADORec("Type") = oItem.Type
oADORec("Name") = oItem.Name
oADORec("Size") = oItem.Size
oADORec("DateCreated") = oItem.DateCreated
oADORec("DateLastAccessed") = oItem.DateLastAccessed
oADORec("DateLastModified") = oItem.DateLastModified
Next
'Делим запрос по параметру сортировки
Query = Split(Query,"order by",-1,vbTextCompare)
'Часть для фильтра передаём в фильтр
oADORec.Filter = Trim(Query(0))
'Часть для сортировки передаём в сортировку
if Ubound(Query) > 0 Then oADORec.Sort = Trim(Query(1))
'Обратно отдаём отфильтрованный и отсортированный массив исходных элементов
'Подробнее на http://www.w3schools.com/ado/met_rs_getrows.asp
if oADORec.EOF Then
FilterFolderItems = Array()
Else
FilterFolderItems = oADORec.GetRows(adGetRowsRest,adBookmarkFirst,"Item")
End If
End Function
Подумал. Возможно более логичный вариант возвращать из функции сам Recordset.
Собрал функцию FolderItemsToRecordset(oItems)
oItems - Элементы Files или SubFolders (коллекции файлов или подкаталогов), полученные от Scripting.FileSystemObject
Заготовка №2
Option Explicit
Const TemporaryFolder = 2
Dim FileSystemObject, FolderPath, Folder, oRecords, strTmp
'Создаём объект для работы с файловой системой
Set FileSystemObject = CreateObject("Scripting.FileSystemObject")
'Получаем путь до каталога временных файлов (просто для примера).
FolderPath = FileSystemObject.GetSpecialFolder(TemporaryFolder)
'FolderPath = "C:\Windows\Web\Wallpaper"
'Получаем объектное представление каталога.
Set Folder = FileSystemObject.GetFolder(FolderPath)
'*** Пример ***
Set oRecords = FolderItemsToRecordset(Folder.Files)
'Фильтруем элементы за последние 5 дней
oRecords.Filter = "DateLastModified > #" & Date()-5 & "# AND DateLastModified < #" & Date() & "#"
'Сортируем в обратном порядке по размеру
oRecords.Sort = "Size DESC"
strTmp = "Выборка файлов изменённых за последние 3 дня и сортировка по размеру в обратном порядке." & String(2,vbCrlf) & "Filter: " & oRecords.Filter & vbCrlf & "Sort: " & oRecords.Sort & String(2,vbCrlf)
'Перебираем записи
Do While Not oRecords.EOF
strTmp = strTmp & FormatDateTime(oRecords("DateLastModified"),2) & String(2,vbTab) & oRecords("Size") & "Б" & String(1,vbTab) & oRecords("Extension") & String(1,vbTab) & oRecords("Name") & vbCrlf
oRecords.MoveNext
Loop
'Выводим результат сортировки
MsgBox strTmp, 0, "Пример"
'Функция сортировки и фильтрации переданных файлов или каталогов
'oItems - Элементы Files или SubFolders (коллекции файлов или подкаталогов), полученные от Scripting.FileSystemObject
Function FolderItemsToRecordset(oItems)
Const adVarChar = 200
Const adDouble = 5
Const adDate = 7
Dim oADORec, oItem
Set oADORec = CreateObject("ADODB.Recordset")
'Создаём поля под размещаемые элементы
With oADORec.Fields
.Append "Name", adVarChar, 255
.Append "Type", adVarChar, 255
.Append "Extension", adVarChar, 10
.Append "Size", adDouble
.Append "DateCreated", adDate
.Append "DateLastAccessed", adDate
.Append "DateLastModified", adDate
End With
'Открываем рекордсет для добавления данных
oADORec.Open
Set FolderItemsToRecordset = oADORec
'Заполняем переданными элементами
For Each oItem in oItems
oADORec.AddNew
oADORec("Name") = oItem.Name
oADORec("Type") = oItem.Type
oADORec("Size") = oItem.Size
oADORec("DateCreated") = oItem.DateCreated
oADORec("DateLastAccessed") = oItem.DateLastAccessed
oADORec("DateLastModified") = oItem.DateLastModified
If TypeName(oItem) = "File" And InStr(1,oItem.Name,".") Then
oADORec("Extension") = LCase(Trim(Mid(oItem.Name, InStrRev(oItem.Name, ".") + 1)))
End If
Next
oADORec.MoveFirst
End Function
Передумал переделывать мир. Пашет и так, ну и ладно. Сделаю лучше свой !