MyTetra Share
Делитесь знаниями!
количество файлов в определенной папке
Время создания: 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

'=======================================================================================

 

Так же в этом разделе:
 
MyTetra Share v.0.65
Яндекс индекс цитирования