|
Zu dem Problem wird dir jeder ne andere Lösung nennen. Die am häufigsten dargelegte ist vermutlich eine mittels Windows API.
Hier mal ein Beispiel wie es mit VBA-Boardmitteln geht, ganz ohne Windows API (oder sonstigen externen Schnick-Schnack):
Damit sammelt man die gesuchten Dateien in einer Liste. Man kann das auch mit verschiedenen Dateitypen machen, allerdings könnte man hierfür noch was optimieren - darauf habe ich hier aber wegen Wahrung der Übersichtlichkeit verzichtet.
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
'Hauptfunktion zum Suchen nach Dateien
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
'Hilfsfunktion von GetFiles()
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
Grüße
|