VBA Tools

W przypadku kiedy, chcemy odwołać się do plików które zostały utworzone np do tygodnia wstecz możemy użyć następującej procedury:

Sub ListFilesFolder()
'MVP OShon from VBATools.pl
Dim ob As Object, pliki As Object, plik As Object
Dim folder As Object, sciezka$, r&: r = 2
sciezka = "C:\Temp\"
 Cells(1, 1) = "nazwa pliku"
 Cells(1, 2) = "plik ze ścieżka"
 Cells(1, 3) = "rozmiar"
 Cells(1, 4) = "rodzaj"
 Cells(1, 5) = "utworzono"
 Cells(1, 6) = "ostatnio otwarty"
 Cells(1, 7) = "data modyfikacji"
 Cells(1, 8 ) = "atrybut"
 Cells(1, 9) = "ścieżka dos"
Set ob = CreateObject("Scripting.FilesystemObject")
Set folder = ob.GetFolder(sciezka)
Set pliki = ob.GetFolder(folder).Files

With Application
 .ScreenUpdating = False
 .EnableEvents = False
 For Each plik In pliki
'przykład ograniczeń:
 'If Mid(LCase(plik), InStrRev(plik, ".") + 1, 3) = "xls" Then 'ograniczenie po rodz pliku
 'If CDate(plik.DateCreated) > Format(Now - 7, "YYYY-MM-DD") Then 'ograniczenie po dacie
 Cells(r, 1) = plik.Name
 Cells(r, 2) = folder & "\" & plik.Name
 Cells(r, 3) = plik.Size
 Cells(r, 4) = plik.Type
 Cells(r, 5) = plik.DateCreated
 Cells(r, 6) = plik.DateLastAccessed
 Cells(r, 7) = plik.DateLastModified
 Cells(r, 8 ) = plik.Attributes
 Cells(r, 9) = plik.ShortPath & plik.ShortName
 r = r + 1
 'End If
 'End If
 Next plik
 .ScreenUpdating = True
 .EnableEvents = True
End With
End Sub

Deklaracje: ścieżka oraz ograniczenia: rozszerzenia oraz daty utworzenia mogą zostać zmodyfikowane.

Można też za pomocą parametrów metody FSO wyznaczyć np: maksymalną datę w danym katalogu (ostatni plik):

Sub LastFileFolder()
'MVP OShon from VBATools.pl
Dim ob As Object, pliki As Object, plik As Object
Dim folder As Object, x&, y&
Const sciezka$ = "C:\Temp\"
Set ob = CreateObject("Scripting.FilesystemObject")
Set folder = ob.GetFolder(sciezka)
Set pliki = ob.GetFolder(folder).Files
ReDim naj(1 To 2, 1 To pliki.Count)

With Application
 .ScreenUpdating = False
 .EnableEvents = False
 For Each plik In pliki
 If Mid(LCase(plik), InStrRev(plik, ".") + 1, 3) = "png" Then 'ograniczenie po rodz pliku
 x = x + 1
 naj(1, x) = plik.Name
 naj(2, x) = plik.DateCreated '.DateLastAccessed'.DateLastModified
 If x > 1 Then
 If naj(2, y) < naj(2, x) Then y = x
 Else
 y = x
 End If
 End If
 Next plik
 .ScreenUpdating = True
 .EnableEvents = True
End With
MsgBox "Data ostatniego pliku *.png: " & naj(2, y) & vbCr & "Plik o nazwie: " & naj(1, y)
End Sub

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.