Как передать список файлов в каталоге в массив, без создания таблицы
Каталоги, массивы и стеки… В модуль QuickSеrvice я добавил пару новых функций. Небольшое отступление. Раньше, для того чтобы получить список файлов в каталоге, я держал таблицу ListFile. Функцией DIR я заполнял через рекордсет таблицу именами файлов. Когда требовалось сравнить два каталога, я заполнял таблицу , и потом, "на живую" сравнивал через ту же функцию DIR имена файлов в рекордсете и проходящие имена при чтении каталога через функцию DIR. Идея решения проблемы: Пройти имена файлов в каталоге и занести их в массив. Но: неизвестно, какой размерности надо объявить массив. Можно пробежать список файлов функцией DIR со счетчиком, создать массив, по максимальному значению счетчика и потом пробежаться функцией DIR по каталогу еще раз, заполняя массив уже именами файлов… Два раза пробегать каталог - нерационально. И тогда я вспомнил про стеки. Стеку не нужна размерность!!! Натолкал туда и потом в обратном порядке куда надо - слил… В Access'е класса Stack не оказалось. Помогли Кен Гетц и Майк Джилберт. У них я "спер" два модуля класса. Они будут описаны в самом низу. Проблема решена так: При чтении каталога работает счетчик , а имена файлов забиваются в стек. По окончании чтения каталога Объявляется одномерный массив с размерностью максимального значения счетчика и данные "переливаются" по циклу в массив. И функция которая это делает его и возвращает! В результате: скорость возрастает вдвое, таблица для списка файлов не нужна, а сравнивать можно сколько хошь каталогов :) Function adhListFile(strPath As String) As Variant 'функция возращает список файлов в каталоге strPath 'Пример aDir = adhListFile("С:Work" Dim strFilename As String Dim aListFile As Variant, iCntFiles As Long Dim aLFiles() As String iCntFiles = 0 Dim stkTest As New Stack strFilename = Dir(strPath & "*.dbf") Do While strFilename <> "" iCntFiles = iCntFiles + 1 'Заносим имя файла в стек stkTest.Push strFilename strFilename = Dir Loop Dim i As Long If iCntFiles = 0 Then 'Кто может, подскажите, как сделать красивее ' условие, если массив пуст adhListFile = Array(0, "Массив пуст :(") Exit Function End If 'Назначаем размер массива ReDim aLFiles(1 To iCntFiles) As String 'И "сливаем" данные из стека в массив For i = iCntFiles To 1 Step -1 aLFiles(i) = stkTest.Pop Next 'Все... adhListFile = aLFiles End Function
|
Теперь надо создать два модуля класса, что бы вышеприведенная функция работала. В панели иструментов выберите создание модуля класса. Один назовите Stack, а другой NextItem Public Sub Push(ByVal varText As String) 'Модуль класса Stack ' Add a new item to the top of the stack. Dim siNewTop As New StackItem siNewTop.Value = varText Set siNewTop.NextItem = siTop Set siTop = siNewTop End Sub
Property Get StackTop() As Variant If StackEmpty Then StackTop = Null Else StackTop = siTop.Value End If End Property Property Get StackEmpty() As Boolean ' Is the stack empty? It can ' only be empty if siTop is Nothing. StackEmpty = (siTop Is Nothing) End Property Private Sub Class_Initialize() Set siTop = Nothing End Sub
Private Sub Class_Terminate() Set siTop = Nothing End Sub
|
Модуль класса NextItem Option Compare Database Option Explicit
' From "VBA Developer's Handbook" ' by Ken Getz and Mike Gilbert ' Copyright 1997; Sybex, Inc. All rights reserved. ' StackItem class. ' Keep track of the next stack item, ' and the text of this item. Public Value As String Public NextItem As StackItem Private Sub Class_Initialize() Set NextItem = Nothing End Sub
Private Sub Class_Terminate() Set NextItem = Nothing End Sub
|
А вот написана еще одна функция в модуль QuickService по сравнению каталогов Он сыроват :( и все уточнения, замечания и улучшения с удовольствием внесу. А уж если в этом еще и кто-то нуждается … Function adhListFileCompare(strDir1 As String, strDir2 As String, intMode As Long) As Variant 'функция сравнивает директории, 'strDir1 - первый каталог 'strDir2 - второй каталог 'отбирает новые файлы в каталоге dir2 при intMode=1 'Отбирает совпадающие файлы в каталоге dir2 при intMode = 2 'возвращает массив c именами файлов Dim aDir1 As Variant, aDir2 As Variant Dim i1 As Long, i2 As Long Dim blnIfExist As Boolean blnIfExist = False aDir1 = adhListFile(strDir1) aDir2 = adhListFile(strDir2) Dim aLFiles() As String, iCntFiles As Long iCntFiles = 0 'Часики DoCmd.Hourglass True Dim stkTest As New Stack For i2 = 1 To UBound(aDir2) For i1 = 1 To UBound(aDir1) If aDir2(i2) = aDir1(i1) Then blnIfExist = True End If Next i1 Select Case intMode Case 1 If blnIfExist <> True Then iCntFiles = iCntFiles + 1 stkTest.Push aDir2(i2) End If Case 2 If blnIfExist = True Then iCntFiles = iCntFiles + 1 stkTest.Push aDir2(i2) End If End Select blnIfExist = False Next i2 If iCntFiles = 0 Then adhListFileCompare = Array(0, "Массив пуст :(") Exit Function End If Dim i As Long ReDim aLFiles(1 To iCntFiles) As String For i = 1 To iCntFiles aLFiles(i) = stkTest.Pop Next adhListFileCompare = aLFiles 'Часики DoCmd.Hourglass False End Function
|
Просмотров: 4846
Ваш коментарий будет первым | | |