Office: Ordner auslesen auf Excel

Stofflggg · 10. März 2018

Mit diesem Code kann man die Dateistruktur inkl. diverser Eigenschaften auslesen und im Excel importieren.

Jedoch wird immer nur die 1. und 2. Ebene (Ordner-Ebene) importiert.

Leider werden jedoch nicht weitere Ebenen importiert.

Woran kann das liegen?

Vielen herzlichen Dank für eine Hilfe.

Code:

Sub Dateieigenschaften_Import()
Dim i As Long
Dim j As Integer
Dim objShell As Object
Dim BrowseDir, fso, fsof, fsof_
Dim strVerzeichnis As String
Dim fi As Long
Dim fs As Object
Set objShell = CreateObject("Shell.Application")
Dim Eigenschaften()
Eigenschaften = Array(0, 3, 4, 10, 22, 23, 24, 126, 127, 177, 178, 176, 175, 180)

Set BrowseDir = objShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
On Error Resume Next

strVerzeichnis = BrowseDir.Items().Item().Path
If Err.Number 0 Then
Exit Sub
End If
Cells.Clear

Set objFolder = objShell.Namespace("" & strVerzeichnis & "")
For Each strFileName In objFolder.Items
If Trim(objFolder.GetDetailsOf(strFileName, 2)) "Dateiordner" Then
For j = 0 To UBound(Eigenschaften)
Cells(i + 2, 1) = strVerzeichnis
Cells(i + 2, j + 2).Value = Trim(objFolder.GetDetailsOf(strFileName, Eigenschaften(j)))
Next
i = i + 1
End If
Next
Set fs = CreateObject("Scripting.FileSystemObject")
Set fso = fs.GetFolder(strVerzeichnis)
Set fsof = fso.SubFolders
For Each fsof_ In fsof
Set objFolder = objShell.Namespace("" & fsof_ & "")
For Each strFileName In objFolder.Items
If Trim(objFolder.GetDetailsOf(strFileName, 2)) "Dateiordner" Then
For j = 0 To UBound(Eigenschaften)
Cells(i + 2, 1) = fsof_
Cells(i + 2, j + 2).Value = Trim(objFolder.GetDetailsOf(strFileName, Eigenschaften(j)))
Next
i = i + 1
End If
Next
Next
Cells(1, 1) = "Name"
For j = 0 To UBound(Eigenschaften)
Cells(1, j + 2) = objFolder.GetDetailsOf(, Eigenschaften(j))
Next
Columns.AutoFit
Columns(3).Replace What:="KB", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Lastrow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(Lastrow + 1, 2).Value = "Anzahl Dateien:"
Cells(Lastrow + 1, 3).Value = WorksheetFunction.CountA(Range("C2:C" & Lastrow - 1))
Cells(Lastrow + 2, 2).Value = "Speicherbedarf:"
Cells(Lastrow + 2, 3).Value = WorksheetFunction.Sum(Range("C2:C" & Lastrow - 1))
MsgBox "Ordner " & strVerzeichnis & " wurde ausgelesen!"
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

haklesoft · 11. März 2018

Hallo,

ohne rekursiven Aufruf bekommst Du die weiteren Unterverzeichnisse nicht gelistet.

Eine rekursionsfreie Auflistung kann man mit DOS-Befehlen realisieren: Code:

Option Explicit

Private Declare Sub OemToChar Lib "user32" Alias "OemToCharA" (ByVal StrFrom As String, ByVal StrTo As String)

' Dateien im gesamten Verzeichnisbaum auflisten. Variante mit DOS-Dir und ohne Rekursion
' Achtung: Umlautumwandlung ASCII to ANSI sollte erfolgen.
Sub showFiles()
Dim i As Long, ar() As String
ar = FullNamesInStructure("C:\temp")
For i = LBound(ar) To UBound(ar) - 1
' für dieses Beispiel Ausgabe im Direktfenster
Debug.Print i + 1, ar(i)
Next i
End Sub

' ### Interne Arbeitsroutinen ###

' Liefert die Fullnames aller passenden Dateien in der Pfadstruktur als Stringarray in sortierter Reihenfolge
Private Function FullNamesInStructure(ByVal sPath As String, Optional ByVal sPattern As String = "*.*") As String()
sPath = IIf(Right$(sPath, 1) Application.PathSeparator, sPath & Application.PathSeparator, sPath) & sPattern
FullNamesInStructure = Split(Ascii2Ansi(CreateObject("wscript.shell").exec("cmd /c dir " & sPath & " /b /a:-d /s /o:n").StdOut.ReadAll), vbCrLf)
End Function

' Wandelt ASCII-Zeichen zu ANSI um
Private Function Ascii2Ansi(ByVal sAscii As String) As String
OemToChar sAscii, sAscii
Ascii2Ansi = sAscii
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

rastrans · 11. März 2018

Weil du nur ein Verzeichnis kontrollierst!
Code:

Set fs = CreateObject("Scripting.FileSystemObject")
'Hier wird das Verzeichnis bestimmt!
Set fso = fs.GetFolder(strVerzeichnis)
'Hier werden die Unterordner des Verzeichnisses gelesen!
Set fsof = fso.SubFolders
'gehe durch alle gefundenen Unterverzeichnisse
For Each fsof_ In fsof
Set objFolder = objShell.Namespace("" & fsof_ & "")
For Each strFileName In objFolder.Items
If Trim(objFolder.GetDetailsOf(strFileName, 2)) "Dateiordner" Then
For j = 0 To UBound(Eigenschaften)
Cells(i + 2, 1) = fsof_
Cells(i + 2, j + 2).Value = Trim(objFolder.GetDetailsOf(strFileName, Eigenschaften(j)))
Next
i = i + 1
End If
Next
Next
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Danach springst du nicht zurück, um weitere Verzeichnisse zu prüfen. Entweder eine weitere Schleife programmieren, oder über Rekursion nachdenken!

Wenn du die den Verweis Mircosoft Scripting Runtime einbindest, wird der Code vielleicht ein einfach! [Link zu Hilfe]

Stofflggg · 18. März 2018

Danke mal für den Hinweis mit der Schleife.

Ich habe das nun mal so probiert - leider kommt da kein weiterer Unterordner raus *entsetzt

Code:

Set fs = CreateObject("Scripting.FileSystemObject")
Set fso = fs.GetFolder(strVerzeichnis)
Set fsof = fso.SubFolders
Set fsoff = fsof.SubFolders

For Each fsoff_ In fsoff
Set objFolder = objShell.Namespace("" & fsoff_ & "")

For Each fsof_ In fsof
Set objFolder = objShell.Namespace("" & fsof_ & "")

For Each strFileName In objFolder.Items
If Trim(objFolder.GetDetailsOf(strFileName, 2)) "Dateiordner" Then

For j = 0 To UBound(Eigenschaften)
Cells(i + 2, 1) = fsof_
Cells(i + 2, j + 2).Value = Trim(objFolder.GetDetailsOf(strFileName, Eigenschaften(j)))
Next
i = i + 1
End If

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

kermit000555 · 23. März 2018

Hallo Zusammen,

Ich habe das gleiche Problem. Vielleich könnte ihr mir dabei helfen so das der Code auch alle Unterordner mit auslist. Bin VBA ein Anfänger und habe einige Veränderungen ausprobiert, aber leider ohne erfolg.
Vorab besten Dank.

Gruß
Kermit

rastrans · 23. März 2018

Hier ein Code, alle Verzeichnisse und Unterverzeichnisse in die Spalte A schreibt.
VORSICHT: Das kann lange dauern, da es viele Unterverzeichnisse gibt! Code:

Private Sub ListDir(Root As String, Optional RootSub As Boolean = False)
On Error Resume Next
Dim lngZeile As Long
Dim fso As New FileSystemObject
Dim f As Folder, sf As Folder

Set f = fso.GetFolder(Root)
For Each sf In f.SubFolders
lngZeile = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(lngZeile, 1).Value = sf.Name
If RootSub Then Call ListDir(sf.path, RootSub)
Next
End Sub

Sub StartProcedure()
Call ListDir(Environ("USERPROFILE"), True)
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit dem zweiten Parameter kannst du angeben, ob du die Unterverzeichnisse der Unterverzeichnisse anzeigen möchtest, oder von dem Verzeichniss nur die Unterverzeichnisse.

Um die Prozedur zu nutzen muss in den Verweisen Mircosoft Scripting Runtime markiert sein!!!

Drogist · 23. März 2018

Moin Kermit,
ich mache das seit einiger Zeit ausschließlich ohne VBA, nämlich ganz bequem mit Power Query ...

Oberschlumpf69 · 23. März 2018

Hi Drogist

tolle Antwort^^
Und warum zeigst du nicht, WIE so etwas in Power Query geht?!

Ciao

Oberschlumpf69 · 23. März 2018

Hi Stofflggg,

wie schon von jemandem im Ansatz erwähnt, könnte dir der DOS-Befehl DIR helfen.

Versuch es mal mit der Datei, die ich meiner Antwort angehängt habe (hat nix mit VBA zu tun!)

Du musst die Datei vorm Starten entpacken.
Speicher die entpackte Datei in dem Verzeichnis, aus dem du alle Unterverzeichnisse finden willst.

Meine Datei erstellt eine txt-Datei.
Öffne diese txt-Datei, und du siehst alle (Unter)Verzeichnisse.

Jetzt könntest du die txt-Datei in Excel importieren und weiterverarbeiten.

Hilfts?

Ciao
Thorsten

kermit000555 · 23. März 2018

Hallo,

Danke für die schnelle Reaktionen. Ich suche schon lange nach einem geeigneten VBA, das Problem ist das ich für meine Projekte eine Office Version 64 bit brauche. Und der Code oben läuft ohne Probleme, halt nur in 2 Ebenen.
Power Query sieht gut aus, werde ich mir auch mal anschauen.
Vielleicht könnten ihr ja mal den Code kpl. reinstellen. Ich weis nicht wirklich wo ich den einfügen soll (Anfänger). So wie gesagt das er alle Unterverzeichnisse mit auslist. Die Zeit spiel keine rolle für das auslesen.
Oder wie geht das mit der ausgelesen Text-Datei in Excel importieren und weiterverarbeiten. Sprich mit dem oben gezeigten Code.

gruß
Kermit

Storax · 23. März 2018

Google sollte doch die Frage vollständig beantworten.
Und auch hier im Forum gibt es dazu Einträge, u.a. von mir
http://www.ms-office-forum.net/forum...light=GetFiles
http://www.ms-office-forum.net/forum...light=GetFiles

Drogist · 12. Januar 2021

von Oberschlumpf69

tolle Antwort^^
Und warum zeigst du nicht, WIE so etwas in Power Query geht?!
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Weil ich keine Lust (mehr) habe, mir andauernd anzuhören, dass Power Query nicht installiert werden darf oder es aus irgendwelchen Gründen doch VBA sein soll. Und es gibt ja so einige Quellen im www, sogar in deutscher Sprache

Beispiele: http://www.excel-ist-sexy.de/power-q...erzeichnisses/ oder etwas ausführlicher: http://www.excel-ist-sexy.de/alle-da...ers-auflisten/

kermit000555 · 23. März 2018

Ok. Danke dir trotzdem,

Erlaube mir noch eine Frage. Wie kam man in Power Query die einzeln Dateigrößen (MB, Kb) mit auslesen? Dann bin ich zufrieden.

gruß
Kermit

Drogist · 23. März 2018

Moin Kermit,
erweitere die Überschrift "Attributes" und aktiviere (nur) Size, dann hast du das Ergebnis in Byte (Untereinheiten musst du nach eigenem Geschmack [1000er/1024er Gruppierung] selber umrechnen) in einer getrennten Spalte.

Office: Ordner auslesen auf Excel

Ordner auslesen auf Excel

Ordner auslesen auf Excel

Ordner auslesen auf Excel

Ordner auslesen auf Excel

Ordner auslesen auf Excel

Ordner auslesen auf Excel - Similar Threads - Ordner auslesen Excel

Sharepoint Ordner auslesen

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

Ordner auslesen

Dateinamen aus Ordner auslesen

Desktoppfad auslesen und Ordner anlegen (wenn nicht vorhanden)

Ordner auslesen, Änderungsdatum, erstellt am...

Ordner mit Rechnungsnr. auslesen und nächste verwenden