Access

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



• Lista podfolderów w folderze roboczym

Na stronie Dir. Lista folderów przedstawiłem wykorzystanie wbudowanej funkcji Dir i komendy Dir w oknie poleceń cmd do uzyskania listy podfolderów w folderze roboczym "C:\MyFiles\", który zawierał podfoldery i pliki o przeróżnych (czasami bardzo dziwnych) nazwach i różnych atrybutach. Ponieważ ani funkcja Dir, ani komenda Dir nie dały zadawalających wyników, na stronie FSO. Lista folderów przedstawiłem funkcję wykorzystując usługę Windows Script Host (WSH) i jej obiekt FileSystemObject, który zapewnia dostęp do systemu plików komputera.

Wyszukiwanie podfolderów za pomocą funkcji API.

Jedną z funkcji API umożliwiającą wyszukiwanie plików i folderów jest funkcja FindFirstFile(...) Funkcja ta otwiera uchwyt wyszukiwania i zwraca informacje o pierwszym znalezionym pliku lub folderze o nazwie pasującej do określonego wzorca. Może to być, ale nie musi, pierwszy plik lub folder na liście otrzymanej innymi metodami. Spowodowane jest to tym, że funkcja FindFirstFile(...), (podobnie jak wbudowana funkcja Dir) nie sortuje wyników wyszukiwania.

• Użyte funkcje API

Funkcja FindFirstFile 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.
Uwaga: Próba otwarcia wyszukiwania, gdy podana nazwa pliku zawiera na końcu znak backslash (\), zawsze kończy się niepowodzeniem.
 Jeżeli wywołanie funkcji FindFirstFile(...) zakończy się sukcesem (zostanie znaleziony plik lub folder) pasujący do wzorca, to funkcja zwróci nam 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 FindNextFile(...) która użyje tych samych filtrów wyszukiwania, które zostały użyte do utworzenia uchwytu wyszukiwania przekazanego w parametrze hFindFile. Przy powodzeniu (znalezieniu pliku lub folderu), funkcja FindNextFile(...) zwraca wartość niezerową, a w strukturze WIN32_FIND_DATA informacje o znalezionym pliku lub folderze. Jeśli funkcja się nie powiedzie, wartość zwracana wynosi ZERO, a zawartość struktury WIN32_FIND_DATA jest nieokreślona. Możemy wtedy sprawdzić właściwość LastDllError obiektu Err. Jeżeli zwrócona wartość równa jest stałej ERROR_NO_MORE_FILES = 18 oznacza to, że nie można znaleźć więcej pasujących plików lub folderów Pozostaje nam wtedy zamknąć uchwyt wyszukiwania za pomocą funkcji FindClose(...).

FindFirstFile
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.
Uwaga: Próba otwarcia wyszukiwania, gdy podana nazwa pliku zawiera na końcu znak backslash (\), zawsze kończy się niepowodzeniem.
 Jeżeli wywołanie funkcji FindFirstFile(...) zakończy się sukcesem (zostanie znaleziony plik lub folder) pasujący do wzorca, to funkcja zwróci nam 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.
FindNextFile(...)
która użyje tych samych filtrów wyszukiwania, które zostały użyte do utworzenia uchwytu wyszukiwania przekazanego w parametrze hFindFile. Przy powodzeniu (znalezieniu pliku lub folderu), funkcja FindNextFile(...) zwraca wartość niezerową, a w strukturze WIN32_FIND_DATA informacje o znalezionym pliku lub folderze. Jeśli funkcja się nie powiedzie, wartość zwracana wynosi ZERO, a zawartość struktury WIN32_FIND_DATA jest nieokreślona. Możemy wtedy sprawdzić właściwość LastDllError obiektu Err. Jeżeli zwrócona wartość równa jest stałej ERROR_NO_MORE_FILES = 18 oznacza to, że nie można znaleźć więcej pasujących plików lub folderów Pozostaje nam wtedy zamknąć uchwyt wyszukiwania za pomocą funkcji FindClose(...).
FindClose(...)
zamyka uchwyt wyszukiwania plików i folderów utworzonych m.in. przez funkcję FindNextFile(...)
IsTextUnicode(...)
zwraca wartość różną od Zera (True), gdy przekazany ciąg znaków jest w formacie Unicode. W przeciwnym wypadku funkcja zwraca Zero (False). Niestety, nie jest to prawdą do końca. Są pewne problemy z prawidłową pracą tej funkcji, zwłaszcza dla krótkich ciągów znaków. Moje próby dostosowania funkcji sprawdzającej uniIsUnicodeText(...), tak by działała jednoznacznie, nie dały do końca zadowalającego efektu. Ale o tym potem, przy opisie funkcji uniIsUnicodeText(...). ⇒ToDo⇐
lstrlen(...)
zawraca długość ciągu znaków (ilość znaków w przekazanym ciągu znaków).

Struktura WIN32_FIND_DATA

Gdy funkcja FindFirstFile(...) lub FindNextFile(...) 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 skorzystamy z elementu dwFileAttributes tej struktury, by sprawdzić, czy znaleziony obiekt jest folderem, a nie plikiem.

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
 

Przykład wykorzystanie elementu dwFileAttributes struktury WIN32_FIND_DATA
w celu określenia, czy znaleziony obiekt jest folderem, a nie plikiem

 
Dim tpWFD As WIN32_FIND_DATA
Const FILE_ATTRIBUTE_DIRECTORY = &H10

If (tpWFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
	' wykonaj instrukcje ...
End If
 

Funkcja wyszukująca podfoldery w folderze roboczym


⊗ Public Function fileListSubFoldersApiW( _
		ByVal sFolderNameW As String, _
		ByRef sSubFoldersRetW() As String, _
	Optional ByVal sMaskW As String = conAsteriskW, _
	Optional fSearchInSubFolders As Boolean = True) As Long
  • Rekurencyjna funkcja fileListSubFoldersApiW (...) wykorzystuje Unicodowe funkcje API w celu znalezienia wszystkich podfolderów w folderze roboczym.
  • argumenty:
    • sFolderNameW:
    • pełna ścieżka określająca roboczy folder, który zostanie przeszukany w celu znalezienia podfolderów. Argument ten musi być przekazany w formacie Unicode.
    • sSubFoldersRetW()
    • 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 w formacie Unicode, znalezionych podfolderów w przekazywanym folderze sFolderNameW
    • 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.
    • sMaskW
    • Argument opcjonalny przekazany w formacie Unicode. 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 Uwagach poniżej pełnego kodu funkcji fileListSubFoldersApiW (...)
  • zwraca:
  • Zwraca liczbę znalezionych podfolderów w folderze roboczym sFolderNameW, a w zwracanym ByRef argumencie sSubfoldersRetW() tablicę, której elementy zawierają pełne ścieżki znalezionych podfolderów (w formacie Unicode) ze znakiem "/" (backslash) na końcu ścieżki.
  • autor: Zbigniew Bratko
  • data: 23.11.2017
Option Compare Database
Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Function FindFirstFile Lib "kernel32" _
          Alias "FindFirstFileW" _
          (ByVal lpFileName As String, _
          lpFindFileData As WIN32_FIND_DATA) As LongPtr
  Private Declare PtrSafe Function FindNextFile Lib "kernel32" _
          Alias "FindNextFileW" _
          (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 "lstrlenW" (ByVal lpString As String) As Long
  Private Declare PtrSafe Function IsTextUnicode Lib "advapi32" _
          (ByVal lpBuffer As String, ByVal cb As Long, lpi As Long) As Long
#Else
  Private Declare Function FindFirstFile Lib "kernel32" _
          Alias "FindFirstFileW" _
          (ByVal lpFileName As String, _
          lpFindFileData As WIN32_FIND_DATA) As Long
  Private Declare Function FindNextFile Lib "kernel32" _
          Alias "FindNextFileW" _
          (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 "lstrlenW" _
          (ByVal lpString As String) As Long
  Private Declare Function IsTextUnicode Lib "advapi32" _
          (ByVal lpBuffer As String, ByVal cb As Long, lpi As Long) As Long
#End If

Private Const MAX_PATH = 520  ' 260*2
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Const IS_TEXT_UNICODE_STATISTICS = &H2

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public 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 * 28 '14*2
End Type

' Znaki pomocnicze i wieloznaczniki w formacie Unicode
Private Const conBackslashW     As String = "\" & vbNullChar
Private Const conDotW           As String = "." & vbNullChar
Private Const conDotDotW        As String = "." & vbNullChar & "." & vbNullChar
Private Const conAsteriskW      As String = "*" & vbNullChar
Private Const conQuestionMark   As String = "?" & vbNullChar

Public Function fileListSubFoldersApiW( _
                               ByVal sFolderNameW As String, _
                               ByRef sSubFoldersRetW() As String, _
                      Optional ByVal sMaskW As String = conAsteriskW, _
                      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 sDirNameW     As String
Dim sFullPathW    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
  ' (takie nietypowe sprawdzenie, czy tablica jest zainicjowana ⇒ToDo⇐)
  If (Not sSubFoldersRetW) <> -1 Then
    lCount = UBound(sSubFoldersRetW) + 1
  End If
 
  ' sprawdź, czy argument sFolderNameW jest formacie Unicode
  ' jeżeli nie, to go przekonwertuj. ToDo (ew. Err.Raise)
  If Not uniIsUnicodeText(sFolderNameW) Then
    sFolderNameW = StrConv(sFolderNameW, vbUnicode)
  End If
   
  ' sprawdź, czy argument jest sFolderNameW formacie Unicode
  ' jeżeli nie, to go przekonwertuj. ToDo (ew. Err.Raise)
  If Not uniIsUnicodeText(sMaskW) Then
    sMaskW = StrConv(sMaskW, vbUnicode)
  End If
   
  ' sprawdź, czy na końcu znajduje się backslach, jeżeli nie to go dopisz
  If StrComp(Right$(sFolderNameW, 2), conBackslashW, vbBinaryCompare) <> 0 Then
    sFolderNameW = sFolderNameW & conBackslashW
  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(sFolderNameW & sMaskW, tpWFD)
 
  ' zacznij szukaj
  If hFindFile <> INVALID_HANDLE_VALUE Then
    Do
      sDirNameW = Left$(tpWFD.cFileName, _
      2 * lstrlen(tpWFD.cFileName))
      ' nie uwzględniaj "." i ".."
      If StrComp(sDirNameW, conDotW, vbBinaryCompare) <> 0 And _
          StrComp(sDirNameW, conDotDotW, vbBinaryCompare) <> 0 Then
 
        ' sprawdź czy znaleziony element jest folderem
        If (tpWFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
          sFullPathW = sFolderNameW & sDirNameW
 
          ' sprawdź, czy przeszukiwać podfoldery
          If fSearchInSubFolders = True Then
            ' dodaj do kolekcji rekurencyjnej
            colSubFolders.Add sFullPathW
          End If
           
          ' dodaj do zwracanej tablicy i zwiększ licznik
          ReDim Preserve sSubFoldersRetW(0 To lCount)
          sSubFoldersRetW(lCount) = sFullPathW & conBackslashW
          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 fileListSubFoldersApiW(colSubFolders.Item(i), sSubFoldersRetW, _
                                  sMaskW, fSearchInSubFolders)
    Next
  End If
  
  If (Not sSubFoldersRetW) <> -1 Then
    fileListSubFoldersApiW = UBound(sSubFoldersRetW) + 1
  End If

  Set colSubFolders = Nothing

End Function

' prototypowa funkcja sprawdzająca, czy tekst jest w formacie Unicode
Public Function uniIsUnicodeText(ByVal sText As String) As Boolean
Dim fRet As Boolean

  If InStr(1, sText, vbNullChar, vbBinaryCompare) > 0 Then
    fRet = True
  Else
    fRet = CBool(IsTextUnicode(ByVal sText, Len(sText), IS_TEXT_UNICODE_STATISTICS))
  End If
  
  uniIsUnicodeText = fRet

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

Funkcja uniIsUnicodeText(...) jest prototypem, i wymaga dokładniejszego dopracowania, gdyż dla poniższych znaków (i ich kombinacji) nie zwraca prawidłowej wartość: ‚    „    …    †    ‡    ‰     ‹    ‘    ’    “”    •    –     —    ™    ›    Ă    ă O funkcji uniIsUnicodeText(...) i poprawkach w najbliższym czasie. ⇒ToDo⇐


Po wywołaniu funkcji fileListSubFoldersAPI(...) otrzymujemy listę podfolderów, zgodną z listą otrzymaną za pomocą funkcji FSO. Lista folderów. Co prawda kolejność podfolderów jest inna, ale to jest bez znaczenia.

Lista podfolderów. Funkcje API

Wyszukiwanie podfolderów z użyciem argumentu sMaskW

Aby przetestować przedstawioną powyżej funkcję fileListSubFoldersAPI(...) utworzyłem folder testowy "C:\MyFilesMask\", który przeszukiwałem przy użyciu wieloznaczników. O ile użycie wieloznacznika "*" nie budzi żadnych obaw, o tyle wieloznacznik "?" jest niestety „wieloznaczny”. Użyty na początku argumentu „sMaskW” w postaci "??e", rzeczywiście oznacza jeden znak. Zwracane są foldery i podfoldery trzyznakowe kończące się na literę "e". Jednak użyty do wyszukania podfolderów o określonej długości, nie sprawdza się.
Argument „sMaskW” w postaci "?r?" użyty w celu wyszukania trzyznakowych folderów zawierających na drugim miejscu literę "r" skutkuje wyszukaniem podfolderów dwuznakowych \pr\ jak i trzyznakowych \pre\, \pre\pre\, a także kombinacji dwu- i trzyznakowych folderów \pr\url\, \pre\pr\.
Argument sMask = "?r???" powinien spowodować zwrócenie tylko pięcioznakowych podfolderów i zawarte w nich pięcioznakowe podfoldery, wszystkie zawierające na drugim miejscu literę "r". Niestety, zwracane zostają m.in. podfoldery
• dwuznakowe: C:\MyFilesMask\pr\, C:\MyFilesMask\pr\ur\,
• trzyznakowe C:\MyFilesMask\pre\pre\, pięcioznakowy C:\MyFilesMask\prace\
• pięcioznakowy podfolder w trzyznakowym folderze C:\MyFilesMask\pre\prace\

Lista podfolderów. Wieloznaczniki. Windows 7
Struktura testowego folderu MyFilesMask i przykłady użycia wieloznacznika "?"

Porównanie z wyszukiwaniem plików i folderów w Windows 7

Wyszukiwarka Windows 7 zachowuje się nieco inaczej, niż przedstawiona powyżej funkcja fileListSubFoldersAPI(...) Dla wzorca wyszukiwania "?r?" „wyszukiwarką Windows 7” zwraca wszystkie foldery, o nazwach nie krótszych niż trzy znaki i zawierające na drugim miejscu literę "r", a przedstawiona funkcja zwraca nazwy wszystkich folderów o nazwach nie dłuższych niż trzy znaki.

Lista podfolderów. Wieloznaczniki
Struktura testowego folderu MyFilesMask i przykłady użycia wieloznacznika "?"

Podobnie dla wzorca wyszukiwania "?r???" „wyszukiwarką Windows 7” zwraca wszystkie foldery, o nazwach nie krótszych niż pięć znaków (ale w folderze o dowolnej długości) i zawierające na drugim miejscu literę "r" (dwa podfoldery), a przedstawiona funkcja zwraca nazwy wszystkich podfolderów o nazwach nie dłuższych niż pięć znaków (osiem podfolderów).