Office: Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner

mücke · 15. April 2019

Moin,

ich habe mir so kurz vor Ostern ein "Ei" ins Netz gelegt und bräuchte mal bitte eure Hilfe *Smilie

Was habe ich vor:
Ich möchte ein Netzwerklaufwert auslesen und die Ordner und Unterordner und Unterordner ... in einer Datei - Tabelle "Übersicht" -auflisten.
Zusätzlich interessiert mich die Anzahl der Unterordner und die Anzahl der Dateien pro Ordner.
Gerne auch getrennt nach den Endungen (.xls, .xlsx, .pdf. usw)

Im Netz habe ich schon viele "Lösungen" gefunden, nur leider keine für mein Vorhaben.
Die meisten sind - ich vermute mal auf Grund der Datenmenge - "in die Knie" gegangen und haben sich aufgehängt.

Die 1ste Ebene hat ca. 100 Ordner, gefolgt von "gefühlten" 50 Unterordnern pro Ordner
und weiteren "gefühlten" 50 Unterordnern pro Ordner ... usw.

Kann mir hier jemand helfen?

Schon mal vielen Dank für Deine Zeit *Smilie
Gruß Dirk

:)

Fennek11 · 17. April 2019

Hallo,

"Kein Problem":

Gibt es in den Ordnernamen Leerzeichen oder Umlaute?

Falls nicht, geht "dir /s *.*", auch direkt aus VBA.

Andernfalls solltest du PowerShell versuchen, geht auch direkt aus VBA.

Als Ansatz:

Code:

Anzahl Dateien eines Ordners
(get-childitem c:temp).count
Ordner zählen:
(Get-ChildItem -Path -Directory -Recurse -Force).Count
von aktuellen Directory aus
(dir -rec -directory | where-object{(dir $_.fullname -directory).count -eq 0}).count

Liste aller Unter-Ordner (files)
gci -directory -recurse
Get-ChildItem -Path c:temp File -recurse -name -include *.py
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mfg

Drogist · 17. April 2019

Moin,
als Ansatz/Basis sollte dir Power Query eine Lösung liefern: => http://www.excel-ist-sexy.de/alle-da...ers-auflisten/

Fennek11 · 17. April 2019

Hallo,

mit VBA für txt- und xls-Dateien:

Code:

Sub Alle_Files_in_FolderStructure()
Pfad = "c:temp"

Ar = Split(CreateObject("wscript.shell").exec("PowerShell get-childitem -Path " & Pfad & _
" File -recurse -name -include *.txt, *.xls, *.xlsx, *.pdf").stdout.readall, vbCrLf)

txt = Filter(Ar, "txt")
xls = Filter(Ar, "xls")

Cells(2, 1).Resize(UBound(txt)) = Application.Transpose(txt)
Cells(2, 2).Resize(UBound(xls)) = Application.Transpose(xls)

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mfg

mücke · 17. April 2019

Moin,

Danke erstmal für eure Lösungsansätze *Smilie

@Fennek11

... Gibt es in den Ordnernamen Leerzeichen oder Umlaute? ...
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ja leider ... es gibt Leerzeichen und Umlaute *frown.gif*

Beim CODE aus #3 bekomme ich zwar eine Auflistung der Dateien, aber nicht so "gelistet" wie ich sie bräuchte.

Die "Ausgabe" sollte so in diese Richtung gehen ... sofern es überhaupt machbar ist.

Spalte A -> der Pfad
Spalte B -> Anzahl der Unterordner für diesen Pfad (Ordner)
Spalte C -> Anzahl der Dateien in diesem Ordner

@Drogist
Power Query ist "aktuell" noch keine Option, werde ich mir aber mal anschauen ... Danke.

Gruß Dirk

Fennek11 · 17. April 2019

versuche mal mit:

Anzahl Files in Subdirectory:
Code:

dir -Recurse | ?{ $_.PSIsContainer } | %{ Write-Host $_.FullName (dir $__.fullname | Measure-Object).Count }
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

https://stackoverflow.com/questions/...-in-subfolders

mücke · 17. April 2019

Moin,

Danke für den Hinweis Fennek11
Dann versuche ich mal mein Glück.

Gruß Dirk

mücke · 6. Mai 2019

Moin in die Runde *Smilie

Es ist vollbracht, ich habe (m)eine Lösung gefunden.

Nach div. Testläufen - mit unterschiedlichen CODE Varianten - bin ich zu dem Entschluss, die zu zählenden Dateien gleich mit aufzulisten und im Nachgang die Anzahl pro Ordner zu ermitteln.

Anbei meine Finale Version.
Der Durchlauf hat ca. 1 ¾ Stunde gedauert, bei ≈ 18.000 Ordner/Unterordner und mehr als 132.000 Dateien.

Gruß Dirk

Code:

Modul

Option Explicit

Private objSheetV As Object
Private objSheetD As Object

Private lngZeileVa As Long
Private lngletzteVa As Long
Private lngZeileVe As Long

Private lngZeileDa As Long

Public Sub AuflistungOrdnerstruktur()

Dim objShell As Object
Dim objItem As Object
Dim objDir As Object
Dim stgDir As String

Set objSheetV = Worksheets("Verzeichnisse")
Set objSheetD = Worksheets("Dateien")

Set objShell = CreateObject("Shell.Application")
Set objDir = objShell.BrowseForFolder(0, "Bitte Ordner auswählen", 0, "T:")

If Not objDir Is Nothing Then
stgDir = objDir.items().Item.Path
Else: Exit Sub
End If

Set objShell = Nothing
Set objDir = Nothing

lngZeileVa = 2
lngZeileVe = 2
lngZeileDa = 2

Call Stammverzeichnis(stgDir)
Call alleVerzeichnisse(stgDir)
Call alleDateien(stgDir)
Call Erweiterungen

End Sub

Private Sub Stammverzeichnis(ByVal stgDir As String)

Dim objFSO As Object
Dim objOrdner As Object
Dim objUnterordner As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrdner = objFSO.GetFolder(stgDir)

For Each objUnterordner In objOrdner.subFolders
objSheetV.Cells(lngZeileVa, 1) = objUnterordner.Path
lngZeileVa = lngZeileVa + 1
Next

Set objFSO = Nothing
Set objOrdner = Nothing
Set objUnterordner = Nothing

End Sub

Private Sub alleVerzeichnisse(ByVal stgDir As String)

Dim objFSO As Object
Dim objOrdner As Object
Dim objUnterordner As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrdner = objFSO.GetFolder(stgDir)

For Each objUnterordner In objOrdner.subFolders
objSheetV.Cells(lngZeileVe, 5) = objUnterordner.Path
lngZeileVe = lngZeileVe + 1
Call alleVerzeichnisse(objUnterordner.Path)
Next

Set objFSO = Nothing
Set objOrdner = Nothing
Set objUnterordner = Nothing

End Sub

Private Sub alleDateien(ByVal stgDir As String)

Dim objFSO As Object
Dim objOrdner As Object
Dim objUnterordner As Object
Dim objDatei As Object

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objOrdner = objFSO.GetFolder(stgDir)

With objSheetD
For Each objUnterordner In objOrdner.subFolders
For Each objDatei In objUnterordner.Files
.Cells(lngZeileDa, 1) = objUnterordner.Path
.Cells(lngZeileDa, 2) = Left(objDatei.DateCreated, 10)
.Cells(lngZeileDa, 3) = objDatei.Name
.Cells(lngZeileDa, 4) = Round(objDatei.Size / 1024, 0)
.Cells(lngZeileDa, 5) = Left(objDatei.DateLastAccessed, 10)
.Cells(lngZeileDa, 6) = Left(objDatei.DateLastModified, 10)
.Cells(lngZeileDa, 7) = objDatei.Type
lngZeileDa = lngZeileDa + 1
Next objDatei
Call alleDateien(objUnterordner.Path)
Next objUnterordner
End With

Set objFSO = Nothing
Set objDatei = Nothing
Set objOrdner = Nothing
Set objUnterordner = Nothing

End Sub

Private Sub Erweiterungen()

With objSheetV
lngletzteVa = .Cells(Rows.Count, 1).End(xlUp).Row

.Range("A1") = "Stammverzeichnis"
.Range("B1") = "Unterordner"
.Range("C1") = "Dateien"
.Range("D1") = "X"
.Range("E1") = "alle Verzeichnisse"
.Range(.Columns(1), .Columns(5)).EntireColumn.AutoFit
.Range("B2:B" & lngletzteVa).FormulaLocal = "=ZÄHLENWENN(E:E;A2&""*?"")"
.Range("B2:B" & lngletzteVa).Value = .Range("B2:B" & lngletzteVa).Value
.Range("C2:C" & lngletzteVa).FormulaLocal = "=ZÄHLENWENN(Dateien!A:A;A2)+ZÄHLENWENN(Dateien!A:A;A2&""*?"")"
.Range("C2:C" & lngletzteVa).Value = .Range("C2:C" & lngletzteVa).Value
End With

With objSheetD
.Range("A1") = "Ordner"
.Range("B1") = "erstellt am"
.Range("C1") = "Dateiname"
.Range("D1") = "Größe in KB"
.Range("E1") = "letzter Zugriff"
.Range("F1") = "letzte Änderung"
.Range("G1") = "Dateityp"
.Range(.Columns(1), .Columns(7)).EntireColumn.AutoFit
End With

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Worksheet BeforeDoubleClick

'Tabellenblatt Verzeichnisse
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If (Target.Column = 1) Or (Target.Column = 6) Then
Cancel = True
Shell "Explorer.exe /n,/e," & ActiveCell & "", vbNormalFocus
Else
Exit Sub
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Code:

Worksheet BeforeDoubleClick

'Tabellenblatt Dateien

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If (Target.Column 3) Then Exit Sub
Cancel = True
Shell "Explorer.exe /n,/e," & ActiveCell.Offset(0, -2) & "" & ActiveCell & "", vbNormalFocus
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner

Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner

Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner

Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner

Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner

Ordner und Unterordner auslesen mit Anzahl der Unterordner/Dateien pro Ordner - Similar Threads - Ordner Unterordner auslesen

Ordner mit Unterordner per VBA erstellen

Daten abgleichen Ordner Unterordner

Ordner via Excelliste erstellen und Unterordner hineinkopieren

Erstellen von Ordner mit Unterordner durch Excel

Ordner mit allen Unterordnern und Dateien in neuen Ordner kopieren

MS Teams / SharePoint übergeordnete Ordner lassen sich nicht löschen, wenn Unterordner oder ...

VBA: Dateien auflisten aus den Unterordnern des aktuellen Ordners (1. Ebene)