VBATools

Lista plików w katalogu

by on Jun.06, 2011, under Excel, Porady

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:

Dla tych, którzy chcą posiadać dobrze wykonany dodatek, wzbogacony o inne opcje polecam: Pobierz listę plików

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): Odpowiedzią na to zagadnienie jest ten dodatek: Pobierz najnowsze pliki

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.

:, , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała