Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1728to1732
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Ordnerstruktur einlesen und ausgeben

Ordnerstruktur einlesen und ausgeben
27.12.2019 09:30:55
Max
Guten Morgen,
ich bin neu hier, generell auch nicht affin mit der VBA Programmierung und auch kein besonderer Foren Nutzer.
Bitte verzeiht mir, wenn ich gegen irgendwelche Regeln verstoße.
Ich komme mal direkt zur Aufgabenstellung:
Ich brauche ein Makro, dass mir alle Ordner, bis zu einer von mir ausgewählten Ebene, eines Pfades heraus gibt. Ohne dabei die darin beinhalteten Dateien aufzulisten.
Bsp.: R:\KM\KMM\M99.0 KMM DVZ 2018
Dieser Pfad hat 10 Ebenen, aber ich möchte nur die Ordner bis Ebene 4 aufzählen oder die Dateien in dem Ordner.
Das soll mir dann in einem Excelsheet übersichtlich ausgegeben werden.
Kann mir da jemand weiterhelfen?
Ich bedanke mich jetzt schon herzlichst bei euch.
Mit freundlichem Gruß

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 09:55:33
Oberschlumpf
Hi Max,
was genau meinst du?
Dein Bsp-Pfad hat nur 3 Ordner-Ebenen.
Ordner1:
R:\KM\
Ordner2:
KMM\
Ordner3:
M99.0 KMM DVZ 2018
Wenn dein Pfad wirklich in Summe 10 Ordner enthält, Bsp:
R:\Ordner1\Ordner2\Ordner3\Ordner4\Ordner5\Ordner6\Ordner7\Ordner8\Ordner9\Ordner10
Dann könnte die Split-Funktion helfen
Sub test()
Dim lstrSplit As String, lstrEbene4 As String. liIdx As Integer, lstrOrdner As String
lstrSplit = Split("R:\Ordner1\Ordner2\Ordner3\Ordner4\Ordner5\Ordner6\Ordner7\Ordner8\ _
Ordner9\Ordner10", "\")
For liIdx = 0 To 4
lstrEbene4 = lstrSplit(liIdx) & "\"
Next
lstrOrdner = Dir(lstrEbene4 & "*.*", vbDirectory)
Do Until lstrOrdner = ""
Debuh.Print lstrOrdner
lstrOrdner = Dir
Loop
End Sub
Hilfts?
Ciao
Thorsten
Anzeige
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 10:11:47
Max
Das hat mir leider nicht geholfen.
Also ich möchte den Pfad einfach reinkopieren. Unter dem Pfad befinden sich dann über mehrere Ebenen Unterordner.
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 10:01:35
ChrisL
Hi
Hier noch die FSO Variante:
Dim FSO, FO, FU, F
Sub OrdnerAuflisten()
Set FSO = CreateObject("Scripting.FileSystemObject")
GetSubFolders "C:\Users"
End Sub
Function GetSubFolders(pfad)
Dim lRow As Long
Set FO = FSO.GetFolder(pfad)
Set FU = FO.SubFolders
On Error Resume Next
For Each F In FU
If Len(F.Path) - Len(Replace(F.Path, "\", "")) 
Die ursprüngliche Vorlage stammt von Sepp: https://www.herber.de/forum/archiv/572to576/572340_Ordner_auflisten_aber_wie.html
cu
Chris
Anzeige
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 10:16:23
Max
Also bei mir kommt da dann der Fehler,
"Fehler beim Kompilieren:
Erwartet: Listentrennzeichen oder )"
wenn ich meinen Pfad bei (Pfad) eintrage.
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 11:15:49
ChrisL
Hi
Komisch, bei mir lief es ohne Probleme. Versuch mal...
GetSubFolders("C:\Users")
Sonst zeig uns bitte deinen angepassten Code.
cu
Chris
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 11:27:55
Max
okay, hatte einen Fehler gemacht gehabt. Hat geklappt, aber nicht so wie ich es brauche.
Schau mal, ich habe hier mit vorher gearbeitet.
Public Sub OrdnerListen_Start()
Dim fso As Object
Dim strPfad As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Start-Verzeichnis wählen"
.ButtonName = "übernehmen"
If .Show  -1 Then Exit Sub
strPfad = .SelectedItems(1)
End With
With ActiveSheet
.UsedRange.ClearContents
Set fso = CreateObject("Scripting.FileSystemObject")
Call OrdnerListen(fso, strPfad, .Range("A1"))  Pfad anpassen!
Set fso = Nothing
End With
End Sub

Private Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As  _
Long, Optional Spalte As Long)
Dim o, uo
Set o = fso.GetFolder(Ordnerangabe)
rng.Offset(Zeile, Spalte).Value = o.Name
Zeile = Zeile + 1
For Each uo In o.SubFolders
Spalte = Spalte + 1
Call OrdnerListen(fso, uo.Path, rng, Zeile, Spalte)
Spalte = Spalte - 1
Next
Set o = Nothing
Set uo = Nothing
End Sub

Ich bin mit der Form der Ausgabe zufrieden, aber ich würde gerne eine Grenze der Ebenen eingeben können.
Anzeige
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 11:44:05
ChrisL
Hier die Begrenzung gemäss Mustercode (max. 4 Backslash)
If Len(F.Path) - Len(Replace(F.Path, "\", "")) < 5 Then
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 11:51:01
Max
Vielen Dank!!
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 11:18:49
Max
Ich habe bis her damit gearbeitet, aber bei soviel Unterordnern ist das eine ewig lange Liste.
Kann jemand den Code so erweitern, dass ich eintippen kann, bis zur welchen Ebene es gehen soll?
Public Sub OrdnerListen_Start()
Dim fso As Object
Dim strPfad As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Start-Verzeichnis wählen"
.ButtonName = "übernehmen"
If .Show  -1 Then Exit Sub
strPfad = .SelectedItems(1)
End With
With ActiveSheet
.UsedRange.ClearContents
Set fso = CreateObject("Scripting.FileSystemObject")
Call OrdnerListen(fso, strPfad, .Range("A1"))  Pfad anpassen!
Set fso = Nothing
End With
End Sub

Private Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As  _
Long, Optional Spalte As Long)
Dim o, uo
Set o = fso.GetFolder(Ordnerangabe)
rng.Offset(Zeile, Spalte).Value = o.Name
Zeile = Zeile + 1
For Each uo In o.SubFolders
Spalte = Spalte + 1
Call OrdnerListen(fso, uo.Path, rng, Zeile, Spalte)
Spalte = Spalte - 1
Next
Set o = Nothing
Set uo = Nothing
End Sub

Anzeige
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 11:36:24
Nepumuk
Hallo Max,
teste mal:
Option Explicit

Public Sub OrdnerListen_Start()
    Dim fso As Object
    Dim strPfad As String, Spalte As String
    Dim Ebenen As Long
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Start-Verzeichnis wählen"
        .ButtonName = "übernehmen"
        If .Show <> -1 Then Exit Sub
        strPfad = .SelectedItems(1)
    End With
    
    Spalte = InputBox("Bis zu welcher Ebene?", "Eingabe", "Alle")
    If StrPtr(Spalte) = 0 Then Exit Sub
    
    If Spalte = "Alle" Then Ebenen = 99999 Else Ebenen = Clng(Spalte)
    
    With ActiveSheet
        
        .UsedRange.ClearContents
        
        Set fso = CreateObject("Scripting.FileSystemObject")
        
        Call OrdnerListen(fso, strPfad, .Range("A1"), Ebenen)
        
        Set fso = Nothing
        
    End With
    
End Sub

Private Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, _
        Ebenen As Long, Optional Zeile As Long, Optional Spalte As Long)

    Dim o As Object, uo As Object
    
    Set o = fso.GetFolder(Ordnerangabe)
    
    rng.Offset(Zeile, Spalte).Value = o.Name
    
    Zeile = Zeile + 1
    
    For Each uo In o.SubFolders
        Spalte = Spalte + 1
        If Spalte < Ebenen Then Call OrdnerListen(fso, uo.Path, rng, Ebenen, Zeile, Spalte)
        Spalte = Spalte - 1
    Next
    
    Set o = Nothing
    Set uo = Nothing
    
End Sub

Gruß
Nepumuk
Anzeige
AW: Ordnerstruktur einlesen und ausgeben
27.12.2019 11:41:13
Max
Boah Nepumuk, du bist meine Rettung.Einfach Top.
Besten Dank!!!

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige