Option Compare Database
Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Function FindFirstFileA Lib "kernel32" _
          (ByVal lpFileName As String, _
          lpFindFileData As WIN32_FIND_DATA) As LongPtr
  Private Declare PtrSafe Function FindNextFileA Lib "kernel32" _
          (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 lstrlenA Lib "kernel32" _
          (ByVal lpString As String) As Long
#Else
  Private Declare Function FindFirstFileA Lib "kernel32" _
          (ByVal lpFileName As String, _
          lpFindFileData As WIN32_FIND_DATA) As Long
  Private Declare Function FindNextFileA Lib "kernel32" _
          (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 lstrlenA Lib "kernel32" _
          (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
  
Public 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 * 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 = FindFirstFileA(sSubfolders(i) & sMask, tpWFD)
		' szukaj następnych plików zgodnych z uchwytem wyszukiwania
		If hFindFile <> INVALID_HANDLE_VALUE Then
			Do
				sFileName = Left$(tpWFD.cFileName, lstrlenA(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 = FindNextFileA(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 = FindFirstFileA(sFolderName & sMask, tpWFD)

	' zacznij szukaj
	If hFindFile <> INVALID_HANDLE_VALUE Then
		Do
			sDirName = Left$(tpWFD.cFileName, lstrlenA(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 = FindNextFileA(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