Option Explicit
Public Sub Demo()
Dim f As VBA.Collection
Debug.Print "[txt]:"; Tab(8); GetFiles("D:\Verz-001\UnterVerz", "*.txt", f)
Debug.Print "[pdf]:"; Tab(8); GetFiles("D:\Verz-103\UnterVerz\UnterUnterVerz", "*.pdf", f)
Debug.Print "#All#:"; Tab(8); f.Count
End Sub
Public Function GetFiles(ByVal Path As String, ByVal Pattern As String, ByRef Files As VBA.Collection) As Long
Dim colFolders As VBA.Collection
Dim strResult As String
Dim i As Long
If Right$(Path, 1) <> "\" Then Path = Path & "\"
If Files Is Nothing Then Set Files = New VBA.Collection
GetFiles = Files.Count
For i = 1 To GetSubFolders(Path, colFolders)
Call GetFiles(Path & colFolders(i), Pattern, Files)
Next
strResult = Dir$(Path & Pattern)
Do Until strResult = ""
Call Files.Add(Path & strResult)
strResult = Dir$()
Loop
GetFiles = Files.Count - GetFiles
End Function
Private Function GetSubFolders(ByVal Path As String, ByRef Folders As VBA.Collection) As Long
Dim strResult As String
Dim attr As VbFileAttribute
If Folders Is Nothing Then Set Folders = New VBA.Collection
If Right$(Path, 1) <> "\" Then Path = Path & "\"
strResult = Dir$(Path, vbDirectory)
Do Until strResult = ""
If strResult <> "." And strResult <> ".." _
And GetAttr(Path & strResult) = vbDirectory _
Then
Call Folders.Add(strResult & "\")
End If
strResult = Dir$()
Loop
GetSubFolders = Folders.Count
End Function