Ordnerstruktur auflisten
07.05.2022 16:00:00
MiSchi
meine Kenntnisse reichen nicht aus, um zu verstehen warum der Code unten mit Verzeichnissen > 3 Ebenen nicht funktioniert.
Es reicht nicht die VerzeichnisTiefe und -Index sowie die If-Abfrage auf höhere Anzahl zu setzten.
Das Makro hat schon im Original das Problem, wenn es auf ein Verzeichnis mit mehr als 3 Unterverzeichnisse trifft danach nicht mehr weiter durchsucht - auch nicht mehr die Verzeichnisse auf der 0. bzw 1. Ebene.
Hat jemand eine Idee woran das liegt - bzw. eine Lösung, dass der Code beliebig viele Unterverzeichnisse tief, richtig arbeitet?
Viele Grüße MiSchi
der code stammt von nighty aus
https://supportnet.de/forum/2341553/ordnersturktur-auflisten-bis-3-ebene
Private strList() As String
Private DicPuffer As String
Private lngCount As Long
Private VerzeichnisTiefe As Integer
Private VerzeichnisIndex As Integer
Public Sub Einlesen()
lngCount = 0
DicPuffer = "C:\Temp"
VerzeichnisTiefe = 0
VerzeichnisIndex = 2 'deine maxebene,null zaehlt mit
SearchFiles DicPuffer, "*.*"
If lngCount = 0 Then
MsgBox "No file found"
Exit Sub
End If
With ThisWorkbook.Worksheets(1)
.Cells.Clear
.Range(.Cells(1, 1), Cells(lngCount, 1)) = _
WorksheetFunction.Transpose(strList)
End With
End Sub
Private Sub SearchFiles(strFolder As String, strFileName As String)
Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolder).Files
If objFile.Name Like strFileName Then
ReDim Preserve strList(lngCount)
strList(lngCount) = objFile.Name
lngCount = lngCount + 1
End If
Next
For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
If strFolder DicPuffer Then
If VerzeichnisTiefe = 2 Then Exit For
VerzeichnisTiefe = VerzeichnisTiefe + 1
End If
If VerzeichnisTiefe = VerzeichnisIndex Then
Exit For
Else
SearchFiles strFolder & "\" & objFolder.Name, strFileName
DicPuffer = strFolder
End If
Next
End Sub