|
|||||||
количество файлов в определенной папке
Время создания: 16.03.2019 23:43
Текстовые метки: FSO,сортировка массива, дата создания
Раздел: Разные закладки - VBA - FSO
Запись: xintrea/mytetra_db_adgaver_new/master/base/15138413760yjbhwuol4/text.html на raw.githubusercontent.com
|
|||||||
|
|||||||
'======================================================================================= '##### количество файлов(всех) в определенной папке ' 'Sub test_FnCountFileInFolder() 'ff = FnCountFileInFolder("strPath") 'End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function FnCountFileInFolder(ByVal strPath As String) As Long On Error Resume Next Set FSO = CreateObject("Scripting.FileSystemObject") Set mainFolder = FSO.GetFolder(strPath)
FnCountFileInFolder = mainFolder.Files.Count
Set FSO = Nothing Set mainFolder = Nothing End Function '=======================================================================================
'======================================================================================= '##### Словарь дат создания файлов в папке(отбор по маске) '' 'Sub test_FnDicDateFileInFSO() 'Set ff = FnDicDateFileInFSO("strPath", "xlsx") 'End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function FnDicDateFileInFSO(ByVal strPath As String, _ ByVal strMask As String) As Object Dim dmainKeyDate As Date Dim CountFile As Long Set FSO = CreateObject("Scripting.FileSystemObject") Set mainFolder = FSO.GetFolder(strPath)
Set dDic = CreateObject("Scripting.Dictionary")
For Each File In mainFolder.Files If InStr(File.Name, strMask) > 0 Then strItem = File.Path dmainKeyDate = Format(File.DateLastModified, "DD.MM.YYYY hh:mm:ss") ' ыы = File.DateCreated ' : DateLastModified : #28.06.2017 11:01:33# : Date If Not dDic.exists(dmainKeyDate) Then dDic.Add dmainKeyDate, strItem CountFile = CountFile + 1 End If
End If
Debug.Print CountFile & " - " & File.DateCreated & " - " & strItem Next 'File
Set FSO = Nothing Set mainFolder = Nothing
Set FnDicDateFileInFSO = dDic
End Function '======================================================================================
'======================================================================================= '#####'Обычная пузырьковая сортировка одномерного массива 'Sub test_FnDicDateFileInFSO() 'strPath = "strPath" ' Set dDic = FnDicDateFileInFSO(strPath, ".xlsx") ' 'сортировка массива ' aTemp = dDic.Keys ' Set DicSort = FnBubbleSort(aTemp, 50) 'End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function FnBubbleSort(ByRef arr, ByVal iCountMax As Integer) As Object Dim i As Long
'сортировка n = UBound(arr) For i = 0# To n Step 1 For j = 0# To n - 1# - i Step 1 If arr(j) > arr(j + 1#) Then ' Stop Tmp = arr(j) arr(j) = arr(j + 1#) arr(j + 1#) = Tmp End If Next j Next i
'словарь с заданным количеством
Dim CountFile As Long Set dDic = CreateObject("Scripting.Dictionary") For i = UBound(arr) To LBound(arr) Step -1 If Not dDic.exists(arr(i)) Then CountFile = CountFile + 1 dDic.Add arr(i), CountFile Debug.Print CountFile & " - " & arr(i) If CountFile >= iCountMax Then Exit For End If Next i Set FnBubbleSort = dDic ''то же самое, но внутри макроса (arr - одномерный массив) ' For i& = LBound(arr) To UBound(arr) - 1 ' For j& = LBound(arr) To UBound(arr) - 2 - i ' If arr(j) > arr(j + 1) Then Tmp = arr(j): arr(j) = arr(j + 1): arr(j + 1) = Tmp ' Next j ' Next i End Function '=======================================================================================
|
|||||||
Так же в этом разделе:
|
|||||||
|
|||||||
|