Страницы: 1
RSS
Сортировка по дате создания файла
 
Здравствуйте.  
С помощью Application.FileDialog(msoFileDialogFilePicker) производится выбор файлов.  
Помогите написать сортировку по дате создания файлов.  
Сортировка должна одновременно делать проход по .SelectedItems и формировать новый массив.
 
Не совсем понятно, чего вы хотите. Автоматически сортировать файлы в процессе выбора или после него?  
В первом случае я не думаю, что это возможно, так как нет API (можно сделать с Common Dialog). Во втором, используйте API для получения даты создания файла.
 
Определить дату создания или последнего изменения файла:  
----------------------------------------  
'http://msoffice.nm.ru/  
iFullName = "C:\Temp\Test.xls"    
iFileDateTime = FileDateTime(iFullName)    
MsgBox "Дата создания или последнего изменения : " & iFileDateTime, , ""    
----------------------------------------
<FONT COLOR="CadetBlue">
 
> Сортировка должна одновременно делать проход по .SelectedItems и формировать новый массив.  
 
А если не одновременно? Создайте новую книгу с одним листом  
workbooks.Add(xlWBATWorksheet)  
, выложите туда список файлов, в соседний столбец - даты по методу Дъмитрия, отсортируйте, заберите в массив, удалите книгу.
 
Для одновременного перебора по .SelectedItems и заполнения нового массива можно использовать сортировку вставками. Для диапазонов на листе она у меня работает.  
Сложность возникла когда попытался написать такую строчку  
A(1) = .SelectedItems(1)  
В чем тут может быть загвоздка?
 
Попробуйте эту функцию: http://excelvba.ru/code/FilenamesCollection  
 
Вроде бы результаты её отсортированы (точно не уверен)
 
{quote}{login=EducatedFool}{date=13.01.2011 05:14}{thema=}{post}Попробуйте эту функцию: http://excelvba.ru/code/FilenamesCollection  
 
Вроде бы результаты её отсортированы (точно не уверен){/post}{/quote}  
 
Возможно, что и отсотртированны, но они используют другой метод.  
Пользователь у меня должен самостоятельно выбрать файлы, а там используется автоматический поиск
 
Насчёт функции я немного не в тему написал)  
 
А в чем сложность преобразовать коллекцию SelectedItems в массив с последующей сортировкой?  
 
Вот весь код:  
 
 
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 ПримерИспользования_GetFilenamesCollection()  
   '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  
 
 
============  
А вот - результат работы:  
 
Дата: 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
 
Спасибо, очень признателен за решение вопроса.  
Проблема оказывается была в отсутствии этой строчки  
ReDim arr(0 To СписокФайлов.Count - 1, 0 To 1)
Страницы: 1
Наверх