Данный код выводит список полных путей файлов, выбранных пользователем в диалоговом окне, отсортированный по дате создания файла:

Function GetFilenamesCollection(Optional ByVal Title As String = "Выберите файлы для обработки", _

Optional ByVal InitialPath As String = "c:\") As FileDialogSelectedItems

' функция выводит диалоговое окно выбора нескольких файлов с заголовком Title,

' начиная обзор диска с папки InitialPath

' возвращает массив путей к выбранным файлам, или пустую строку в случае отказа от выбора

With Application.FileDialog(3) ' msoFileDialogFilePicker

.ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath

If .Show <> -1 Then Exit Function

Set GetFilenamesCollection = .SelectedItems

End With

End Function

Public Function CoolSort(SourceArr As Variant) As Variant

' сортировка ОДНОМЕРНОГО массива по нулевому столбцу

Dim Check As Boolean, iCount As Integer, jCount As Integer, nCount As Integer

ReDim tmpArr(UBound(SourceArr)) As Variant

Do Until Check

Check = True

For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1

If Val(SourceArr(iCount)) > Val(SourceArr(iCount + 1)) Then

For jCount = LBound(SourceArr) To UBound(SourceArr)

tmpArr(jCount) = SourceArr(iCount)

SourceArr(iCount) = SourceArr(iCount + 1)

SourceArr(iCount + 1) = tmpArr(jCount)

Check = False

Next

End If

Next

Loop

CoolSort = SourceArr

End Function

Public Function CoolSort(SourceArr As Variant) As Variant

' сортировка двумерного массива по нулевому столбцу

Dim Check As Boolean, iCount As Integer, jCount As Integer, nCount As Integer

ReDim tmpArr(UBound(SourceArr, 2)) As Variant

Do Until Check

Check = True

For iCount = LBound(SourceArr, 1) To UBound(SourceArr, 1) - 1

If Val(SourceArr(iCount, 0)) > Val(SourceArr(iCount + 1, 0)) Then

For jCount = LBound(SourceArr, 2) To UBound(SourceArr, 2)

tmpArr(jCount) = SourceArr(iCount, jCount)

SourceArr(iCount, jCount) = SourceArr(iCount + 1, jCount)

SourceArr(iCount + 1, jCount) = tmpArr(jCount)

Check = False

Next

End If

Next

Loop

CoolSort = SourceArr

End Function

Sub ВыводОтсортированногоСпискаФайлов()

On Error Resume Next

Dim СписокФайлов As FileDialogSelectedItems

СтартоваяПапка = CreateObject("WScript.Shell").SpecialFolders("Desktop")

' выводим окно выбора

Set СписокФайлов = GetFilenamesCollection("Выберите файлы на рабочем столе", СтартоваяПапка)

If СписокФайлов Is Nothing Then Exit Sub ' выход, если пользователь отказался от выбора файлов

ReDim arr(0 To СписокФайлов.Count - 1, 0 To 1)

For Each File In СписокФайлов ' заполняем двумерный массив

arr(i, 1) = File: arr(i, 0) = Fix(CDbl(FileDateTime(File))): i = i + 1

Next

CoolSort arr ' сортируем двумерный массив

For i = LBound(arr) To UBound(arr) ' выводим файлы в порядке даты создания

Debug.Print "Дата: " & CDate(arr(i, 0)) & " - файл " & arr(i, 1)

Next i

End Sub

Пример результата (из окна Immediate):

Дата: 27.10.2009 - файл C:\Documents and Settings\Admin\Рабочий стол\Apache LOGs parser.xls
Дата: 11.06.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\123Книга1.xls
Дата: 29.08.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\AutoForm.xls
Дата: 24.09.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\2010-09-24.xls
Дата: 12.11.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\111.info
Дата: 12.11.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\111.psm
Дата: 22.11.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\111222.xls
Дата: 28.12.2010 - файл C:\Documents and Settings\Admin\Рабочий стол\Armstrong.xls
Дата: 02.01.2011 - файл C:\Documents and Settings\Admin\Рабочий стол\buch.xls

PS: В коде использована функция сортировки двумерного массива , и функция множественного выбора файлов .

• 7490 просмотров