MyTetra Share
Делитесь знаниями!
количество файлов в определенной папке
16.03.2019
23:43
Текстовые метки: FSO,сортировка массива, дата создания
Раздел: !Закладки - VBA - FSO

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

'##### количество файлов(всех) в определенной папке

'

'Sub test_FnCountFileInFolder()

'ff = FnCountFileInFolder("\\Rudh002113\share_\PASA_WEB\MonitoringSkidReader\PEIN\")

'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("\\Rudh002113\share_\PASA_WEB\MonitoringSkidReader\PEIN\", "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 = "\\Rudh002113\share_\PASA_WEB\MonitoringSkidReader\PEIN\"

' 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.52
Яндекс индекс цитирования