Access

  MS Access 2010+  |  Przetwarzanie plików  |   VBA 7.0



• Lista plików w folderze roboczym i jego podfolderach.

Na stronie API. Lista folderów (Unikod) przedstawiłem rekurencyjną funkcję plikListSubFoldersApiW(...) wykorzystującą funkcje API FindFirstFileW(...) oraz FindNextFileW(...) w celu znalezienia wszystkich podfolderów w folderze roboczym o Unikodowych nazwach. Najczęściej nie musimy wyszukiwać plików i folderów po nazwach unikodowych, więc lepszym sposobem jest skorzystanie z „normalnych” funkcji API wyszukujących pliki i foldery. Odpada także problem ze sprawdzaniem, czy przekazany tekst jest w formacie Unicode za pomocą funkcji API IsTextUnicode oraz konwertowanie przekazywanych i zwracanych ciągów znaków z Unikodu, przez co obsługa plików jest o wiele prostsza i łatwiejsza.

Wyszukiwanie plików w podfolderach za pomocą funkcji API.

• Użyte funkcje API

Funkcja FindFirstFileA wyszukuje pliki i foldery wyłącznie po nazwie pliku, lub wzorcu z użyciem symboli wieloznacznych "?" oraz "*". W wyszukiwaniu nie można określić żadnych atrybutów, takich jak data lub typ pliku. Wyszukiwanie obejmuje długie i krótkie nazwy plików. Jeżeli wywołanie funkcji FindFirstFileA(...) zakończy się sukcesem (zostanie znaleziony plik lub folder) pasujący do wzorca, to funkcja zwraca uchwyt wyszukiwania, a w strukturze WIN32_FIND_DATA informacje o znalezionym pliku lub folderze. Zwrócony uchwyt wyszukiwania możemy użyć w celu wyszukania kolejnego pliku (folderu) za pomocą funkcji FindNextFileA(...) która użyje tego samego filtru wyszukiwania. Przy powodzeniu (znalezieniu pliku lub folderu), funkcja FindNextFileA(...) zwraca wartość niezerową, a w strukturze WIN32_FIND_DATA informacje o znalezionym pliku lub folderze. Aby zakończyć wyszukiwanie powinniśmy zamknąć uchwyt wyszukiwania za pomocą funkcji FindClose(...).

Bardziej szczegółowy opis użytych funkcji i struktur API użytych do wyszukania folderów znajduje się na stronie API. Lista folderów. Na stronie tej jest też przedstawiona funkcja własna plikListSubFoldersApi(...), która zostanie użyta w funkcji wyszukującej pliki w folderze roboczym i jego podfolderach.

Struktura WIN32_FIND_DATA

Gdy funkcja FindFirstFileA(...) lub FindNextFileA(...) zakończy się sukcesem (zostanie znaleziony plik lub folder) pasujący do wzorca, możemy skorzystać ze zwracanej struktury WIN32_FIND_DATA, by pobrać więcej danych o pliku lub folderze. W funkcji fileListSubFoldersAPI(...) wyszukującej podfoldery w folderze roboczym korzystamy z elementu dwFileAttributes tej struktury, by sprawdzić, czy znaleziony obiekt jest folderem, a nie plikiem. W poniżej funkcji plikListFilesW, skorzystamy z elementu dwFileAttributes, by sprawdzić atrybuty pliku. Wyszukiwanie można rozbudować o wyszukiwanie po dacie utworzenia (ftCreationTime), lub dacie modyfikacji (ftLastWriteTime), a także po wielkości pliku (nFileSizeHigh i nFileSizeLow).

Poniżej struktura WIN32_FIND_DATA i krótki opis jej poszczególnych elementów:

Type WIN32_FIND_DATA
dwFileAttributes As Long
atrybuty pliku (ukryty, tylko do odczytu, systemowy lub archiwalny
ftCreationTime As FILETIME
data utworzenia pliku
ftLastAccessTime As FILETIME
data ostatniego dostępu (otworzenia, modyfikacja lub uruchomienie)
ftLastWriteTime As FILETIME
data ostatniej modyfikacji pliku
nFileSizeHigh As Long
rozmiar pliku w bajtach, jako najbardziej znacząca wartość DWORD
nFileSizeLow As Long
rozmiar pliku w bajtach, jako mniej znacząca wartość DWORD
dwReserved0 As Long
zarezerwowane
dwReserved1 As Long
zarezerwowane
cFileName As String * MAX_PATH
nazwa pliku
cAlternate As String * 14
alternatywna nazwa pliku w formacie 8.3
End Type
 

Funkcja wyszukująca pliki w folderze roboczym i podfolderach


⊗ Public Function plikListFiles( _
		ByVal sFolderName As String, _
		sFilesPathRet() As String, _
		tpWFDRet() As WIN32_FIND_DATA, _
	Optional ByVal sMask As String = "*", _
	Optional fSearchInSubFolders As Boolean = True, _
	Optional iAttrib As Integer = -1) As Long
  • Funkcja plikListFiles(...) wykorzystuje funkcje API w celu znalezienia plików w folderze roboczym i jego podfolderach.
  • argumenty:
    • sFolderName
    • pełna ścieżka określająca roboczy folder, który zostanie przeszukany w celu znalezienia podfolderów.
    • sFilesPathRet()
    • zwracana ByRef tablica typu String zawierająca pełne nazwy, znalezionych plików folderze sFolderName i jego podfolderach.
    • tpWFDRet()
    • zwracana ByRef tablica struktur WIN32_FIND_DATA dla każdego pliku. UWAGA! nazwa pliku jest zwracana także w tej strukturze.
    • sMask
    • argument opcjonalny. Domyślna wartość "*". Maska umożliwiająca szukanie wielu plików przy użyciu symboli wieloznacznych takich jak "*" lub "?"
    • fSearchInSubFolders
    • argument opcjonalny. Domyślna wartość True.
      Określa rodzaj operacji, jaka będzie wykonywana w trakcie przeszukiwania folderów. Dla domyślnej wartości argumentu fSearchInSubFolders = True przeszukiwane będą wszystkie podfoldery w folderze roboczym. Dla wartości argumentu fSearchInSubFolders = False przeszukiwanie ograniczone zostanie do folderu roboczego, bez przeszukiwania podfolderów.
    • iAttrib
    • Argument opcjonalny. Domyślna wartość -1, dla której wyszukiwane są wszystkie pliki bez względu na posiadany atrybut. Dla innych wartości iAttrib zwracane są jedynie pliki mające zgodne atrybuty.
  • zwraca:
  • Zwraca liczbę znalezionych plików w folderze roboczym sFolderName, a w zwracanym ByRef argumencie sFilesPathRet() tablicę, której elementy zawierają pełne ścieżki znalezionych plików bez znaku "/" (backslash) na końcu ścieżki.
  • autor: Zbigniew Bratko
  • data: 07.01.2018
Option Compare Database
Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Function FindFirstFile Lib "kernel32" _
          Alias "FindFirstFileA" _
          (ByVal lpFileName As String, _
          lpFindFileData As WIN32_FIND_DATA) As LongPtr
  Private Declare PtrSafe Function FindNextFile Lib "kernel32" _
          Alias "FindNextFileA" _
          (ByVal hFindFile As LongPtr, _
          lpFindFileData As WIN32_FIND_DATA) As Long
  Private Declare PtrSafe Function FindClose Lib "kernel32" _
          (ByVal hFindFile As LongPtr) As Long
  Private Declare PtrSafe Function lstrlen Lib "kernel32" _
          Alias "lstrlenA" (ByVal lpString As String) As Long
#Else
  Private Declare Function FindFirstFile Lib "kernel32" _
          Alias "FindFirstFileA" _
          (ByVal lpFileName As String, _
          lpFindFileData As WIN32_FIND_DATA) As Long
  Private Declare Function FindNextFile Lib "kernel32" _
          Alias "FindNextFileA" _
          (ByVal hFindFile As Long, _
          lpFindFileData As WIN32_FIND_DATA) As Long
  Private Declare Function FindClose Lib "kernel32" _
          (ByVal hFindFile As Long) As Long
  Private Declare Function lstrlen Lib "kernel32" _
          Alias "lstrlenA" _
          (ByVal lpString As String) As Long
#End If
 
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
 
Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
 
Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type


Public Function plikListFiles( _
                 ByVal sFolderName As String, _
                 sFilesPathRet() As String, _
                 tpWFDRet() As WIN32_FIND_DATA, _
        Optional ByVal sMask As String = "*", _
        Optional fSearchInSubFolders As Boolean = True, _
        Optional iAttrib As Integer = -1) As Long
  
#If VBA7 Then
  Dim hFindFile   As LongPtr
  Dim hNextFile   As LongPtr
#Else
  Dim hFindFile   As Long
  Dim hNextFile   As Long
#End If
  
Dim tpWFD         As WIN32_FIND_DATA
Dim sSubfolders() As String
Dim sFileName     As String
Dim iFileAttrib   As Integer
Dim lCount        As Long
Dim i             As Long
  
  ' sprawdź, czy na końcu znajduje się backslach, jeżeli nie to go dopisz
  If StrComp(Right$(sFolderName, 1), "\", vbBinaryCompare) <> 0 Then
    sFolderName = sFolderName & "\"
  End If
    
  ' uwzględnij podfoldery
  If fSearchInSubFolders = True Then
    If plikListSubFoldersApi(sFolderName, sSubfolders(), "*", True) > 0 Then
      ' dostosuj wymiar tablicy do ilości zwróconych podfolderów
      ReDim Preserve sSubfolders(0 To UBound(sSubfolders) + 1)
    Else
      ' brak podfolderów
      ReDim Preserve sSubfolders(0 To 0)
    End If
    ' dopisz katalog główny bez znaku \ na końcu
    sSubfolders(UBound(sSubfolders)) = Left$(sFolderName, Len(sFolderName) - 1)
  Else
    ' dopisz katalog główny bez znaku \ na końcu
    ReDim Preserve sSubfolders(0 To 0)
    sSubfolders(0) = Left$(sFolderName, Len(sFolderName) - 1)
  End If
  
  ' dopisz  znaku \ na końcu nazwy podfolderu
  For i = LBound(sSubfolders()) To UBound(sSubfolders())
    sSubfolders(i) = sSubfolders(i) & "\"
  Next
  
  ' przeszukaj folder roboczy i wszystkie podfoldery (dla fSearchInSubFolders = True)
  For i = LBound(sSubfolders()) To UBound(sSubfolders())
    ' utwórz uchwyt wyszukiwania
    hFindFile = FindFirstFile(sSubfolders(i) & sMask, tpWFD)
    ' szukaj następnych plików zgodnych z uchwytem wyszukiwania
    If hFindFile <> INVALID_HANDLE_VALUE Then
      Do
        sFileName = Left$(tpWFD.cFileName, lstrlen(tpWFD.cFileName))
        ' nie uwzględniaj "." i ".."
        If StrComp(sFileName, ".", vbBinaryCompare) <> 0 And _
          StrComp(sFileName, "..", vbBinaryCompare) <> 0 Then
  
          ' pobierz atrybuty znalezionego elementu
          iFileAttrib = tpWFD.dwFileAttributes
  
          ' uwzględniamy tylko pliki w folderach
          If (iFileAttrib And FILE_ATTRIBUTE_DIRECTORY) = 0 Then
            With tpWFD
              ' wszystkie pliki
              If iAttrib = -1 Then
                ReDim Preserve sFilesPathRet(0 To lCount)
                ReDim Preserve tpWFDRet(0 To lCount)
                sFilesPathRet(lCount) = _
                sSubfolders(i) & sFileName
                tpWFDRet(lCount) = tpWFD
                lCount = lCount + 1
              Else
                ' tylko pliki z wybranymi atrybutem(-ami) - iAttrib
                If (iFileAttrib And iAttrib) = iAttrib Then
                  ReDim Preserve sFilesPathRet(0 To lCount)
                  ReDim Preserve tpWFDRet(0 To lCount)
                  sFilesPathRet(lCount) = _
                  sSubfolders(i) & sFileName
                  tpWFDRet(lCount) = tpWFD
                  lCount = lCount + 1
                End If
              End If
            End With
              
          End If
        End If
        ' szukaj następnego pliku
        hNextFile = FindNextFile(hFindFile, tpWFD)
        
      Loop Until hNextFile = 0
      ' zamknij uchwyt wyszukiwania
      hNextFile = FindClose(hFindFile)
    End If
  Next
  
  plikListFiles = lCount
  
End Function


' Rekurencyjna funkcja plikListSubFoldersApi (...) wykorzystuje funkcje API
' w celu znalezienia wszystkich podfolderów w folderze roboczym.
' argumenty:
' sFolderName:
'   pełna ścieżka określająca roboczy folder, który zostanie przeszukany w celu
' znalezienia podfolderów.
' sSubFoldersRet()
'   tablica typu String, która przekazywana jest ByRef w kolejnych rekurencyjnych
'   wywołaniach funkcji. W każdym wywołaniu uzupełniana jest pełnymi ścieżkami znalezionych
'   podfolderów w przekazywanym folderze sFolderNameW
' sMask
'   Argument opcjonalny. Domyślna wartość "*".
'   Maska umożliwiająca wyszukanie podfolderów przy użyciu symboli wieloznacznych takich
'   jak "*" lub "?". Niestety, wyszukiwanie za pomocą wieloznacznika "?" (question mark)
'   jest nieco odmienne od działania przy użyciu kryterium Like, gdzie pojedynczy znak "?"
'   oznacza jeden znak w ciągu znaków. Ale o tym w „Porównanie z wyszukiwaniem ....” poniżej
'   pełnego kodu funkcji plikListSubFoldersApi (...)
' fSearchInSubFolders
'   Argument opcjonalny. Domyślna wartość True.
'   Określa rodzaj operacji, jaka będzie wykonywana w trakcie przeszukiwania folderów.
'   Dla domyślnej wartości argumentu fSearchInSubFolders = True przeszukiwane będą wszystkie
'   podfoldery w folderze roboczym. Dla wartości argumentu fSearchInSubFolders = False
'   przeszukiwanie ograniczone zostanie do folderu roboczego, bez przeszukiwania podfolderów.
' zwraca:
'   Zwraca liczbę znalezionych podfolderów w folderze roboczym sFolderName, a w zwracanym
'   ByRef argumencie sSubfoldersRet() tablicę, której elementy zawierają pełne ścieżki
'   znalezionych podfolderów bez znaku "/" (backslash) na końcu ścieżki.
' autor: Zbigniew Bratko
' data: 05.01.2018
  
Public Function plikListSubFoldersApi( _
                     ByVal sFolderName As String, _
                     ByRef sSubFoldersRet() As String, _
            Optional ByVal sMask As String = "*", _
            Optional fSearchInSubFolders As Boolean = True) As Long
#If VBA7 Then
  Dim hFindFile   As LongPtr
  Dim hNextFile   As LongPtr
#Else
  Dim hFindFile   As Long
  Dim hNextFile   As Long
#End If
     
Dim tpWFD         As WIN32_FIND_DATA
Dim sDirName      As String
Dim sFullPath     As String
Dim colSubFolders As Collection
Dim lCount        As Long
Static lRet       As Long
Dim i             As Long
     
  ' jeżeli tablica została zainicjowana to ustal ponownie licznik
  ' (nietypowe sprawdzenie, czy tablica jest zainicjowana ?ToDo?)
  If (Not sSubFoldersRet) <> -1 Then
    lCount = UBound(sSubFoldersRet) + 1
  End If
     
  ' sprawdź, czy na końcu znajduje się backslach, jeżeli nie to go dopisz
  If StrComp(Right$(sFolderName, 1), "\", vbBinaryCompare) <> 0 Then
    sFolderName = sFolderName & "\"
  End If
       
  ' zainicjuj kolekcję przechowującą znalezione podfoldery,
  ' by przekazać je w rekurencyjnym wywołaniu
  Set colSubFolders = New Collection
     
  ' zacznij wyszukiwanie, zwróć uchwyt wyszukiwania
  hFindFile = FindFirstFile(sFolderName & sMask, tpWFD)
     
  ' zacznij szukaj
  If hFindFile <> INVALID_HANDLE_VALUE Then
    Do
      sDirName = Left$(tpWFD.cFileName, lstrlen(tpWFD.cFileName))
      ' nie uwzględniaj "." i ".."
      If StrComp(sDirName, ".", vbBinaryCompare) <> 0 And _
          StrComp(sDirName, "..", vbBinaryCompare) <> 0 Then
     
        ' sprawdź czy znaleziony element jest folderem
        If (tpWFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
          sFullPath = sFolderName & sDirName
     
          ' sprawdź, czy przeszukiwać podfoldery
          If fSearchInSubFolders = True Then
            ' dodaj do kolekcji rekurencyjnej
            colSubFolders.Add sFullPath
          End If
               
          ' dodaj do zwracanej tablicy i zwiększ licznik
          ReDim Preserve sSubFoldersRet(0 To lCount)
          sSubFoldersRet(lCount) = sFullPath '& "\"
          lCount = lCount + 1
        End If
      End If
         
      ' szukaj następnego podfolderu
      hNextFile = FindNextFile(hFindFile, tpWFD)
    Loop Until hNextFile = 0
     
    ' zamknij uchwyt wyszukiwania
    hNextFile = FindClose(hFindFile)
         
  End If
     
  ' sprawdź, czy przeszukiwać podfoldery
  If fSearchInSubFolders = True Then
    ' przeszukuj rekurencyjnie podfoldery z kolekcji colSubfolders
    For i = 1 To colSubFolders.Count
      Call plikListSubFoldersApi(colSubFolders.Item(i), sSubFoldersRet, _
                                 sMask, fSearchInSubFolders)
    Next
  End If
      
  If (Not sSubFoldersRet) <> -1 Then
    plikListSubFoldersApi = UBound(sSubFoldersRet) + 1
  End If
    
  Set colSubFolders = Nothing
    
End Function

Uwagi.

Fragment kodu oznaczony komentarzem „Nietypowe sprawdzenie, czy tablica jest zainicjowana” wymaga dalszego doprecyzowania. ⇒ToDo⇐

Nietypowe sprawdzenie, czy tablica jest zainicjowana
If (Not sSubFoldersRetW) <> -1 Then
   ' wykonaj instrukcje
End If