mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Вывод отсортированного списка файлов

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

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, 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: В коде использована функция сортировки двумерного массива, и функция множественного выбора файлов.

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _____         ____    _  __     __        
| ____| ___ |___ \ / | \ \ / / _ __
| _| / __| __) | | | \ \ / / | '_ \
| |___ \__ \ / __/ | | \ V / | |_) |
|_____| |___/ |_____| |_| \_/ | .__/
|_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.