Suche nach Ordnername
13.01.2022 09:07:58
Andy
ich benötige einen kleinen Ratschlag von Euch Profis. Mit nachfolgendem Code durchsuche ich eine Ordnerstruktur immer wieder auf das Vorhandensein eines Unterordners, der maximal in der vierten Ebene des Verzeichnisses zu finden sein müsste. Am Anfang war der Code auch hinreichend schnell, mittlerweile werden aber die Unterordner mit großen Datenmengen gefüllt und daher wird die Suche danach immer zeitaufwändiger.
Zwar gibt es wenig Unterorder, aber eben viele Dateien (Bilder, PDFs usw) darunter. Mittlerweile dauert mir das Durchsuchen zu lange, weshalb ich Euch fragen möchte, ob man den Code nicht optimieren kann (Zb nur bis zur 4 Ebene durchsuchen, Dateien überspringen, nur Ordner suchen)
Hiermit übergebe ich die Suche an die Funktion
Suchordner=Textbox1.Value
NameDesGrundpfads = "Z:\Ablage"
If sPfadOrdnerSuche(NameDesGrundpfads, Suchordner) "" then....
Und so sieht die Funktion aus, die das bisher bewerkstelligt:
Public Function sPfadOrdnerSuche(ByVal pvstrPath As String, ByVal pvstrFoldername As String) As String
Dim astrFolders() As String
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
strPath = pvstrPath
Do
strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
Do Until strFolder = vbNullString
If strFolder "." And strFolder ".." Then
If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
If strFolder = pvstrFoldername Then
sPfadAktenzeichenSuche = strPath & strFolder & "\"
Exit Function
End If
ReDim Preserve astrFolders(0 To ialngIndex1)
astrFolders(ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir$
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = astrFolders(ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
End Function