Clever-Excel-Forum

Guten Tag,

ich würde gerne eine Datei haben in der die Änderungszeiten der Unterordner die sich in einem Order befinden enthalten sind.

Ich hab es geschafft, dass bis zu dem Dateipfad und alle (ich nenn es mal) Direkten Unterordner mit Moddate gelistet werden.

Wenn allerdings in einer der direkten Unterordner noch ein Ordner ist, wird dieser nicht angezeigt.

Beispiel:

Ordner1->Ordner1.1
Ordner1->Ordner1.1->Ordner1.1.1

hier würde nur der Ordner 1.1 gelistet werden der Unterordner 1.1.1 nicht.

Code:
Sub OrdnerListen()

    Dim Pfad As String

    Dim Ordner As String

    Dim row As Integer

    Pfad = "C:\Users\Ich\Desktop\VBA\"

    Ordner = Dir(Pfad, vbDirectory)

    row = 2

    Cells(1, 11) = "Ordner Pfad"

    Cells(1, 12) = "Mod. Datum"

    Do While Ordner <> ""

        If (GetAttr(Pfad & Ordner) And vbDirectory) = vbDirectory And (Ordner <> "." And Ordner <> "..") Then

            Cells(row, 11) = Pfad & Ordner

            Cells(row, 12) = FileDateTime(Pfad & Ordner)

            row = row + 1

        End If

    Ordner = Dir()

    Loop

End Sub

Das ist der code dazu. Wie schaff ich es, dass auch die "unteren" Ordner gelistet werden?

Vg und Danke,

Carsten

Hallo Carsten,

mal ungetestet

Code:
Sub OrdnerListen()

   Dim Pfad As String

   Dim Ordner As String

   Dim row As Integer

   Dim SourceFolder As Object, SubFolder As Object

   Pfad = "C:\Users\Ich\Desktop\VBA\"

   Set SourceFolder = CreateObject("Scripting.FileSystemObject").GetFolder(Pfad)

   Ordner = Dir(Sourcefoldet.Path, vbDirectory)

'   Ordner = Dir(Pfad, vbDirectory)

   If row = 0 Then row = 2

   Cells(1, 11) = "Ordner Pfad"

   Cells(1, 12) = "Mod. Datum"

   Do While Ordner <> ""

       If (GetAttr(Pfad & Ordner) And vbDirectory) = vbDirectory And (Ordner <> "." And Ordner <> "..") Then

           Cells(row, 11) = Pfad & Ordner

           Cells(row, 12) = FileDateTime(Pfad & Ordner)

           row = row + 1

       End If

   Ordner = Dir()

   Loop

   For Each SubFolder In SourceFolder.SubFolders

      OrdnerListen SubFolder.Path

   Next SubFolder

End Sub

Hallo Carsten,

nur mit der Dir()-Funktion geht auch sowas:

'Code von Bernd (bst) 

'http://www.online-excel.de/fom/fo_read.php?f=3&bzh=121&h=120#a123x 



'verändert von Kuwer 



Dim Zeile As Long

Dim strDir() As String

Dim strDirName As String



Sub OrdnerListen()

 Range("K:L") = ""

 Cells(1, 11) = "Ordner Pfad"

 Cells(1, 12) = "Mod. Datum"

 Zeile = 2

 strDirName = "C:\Users\Ich\Desktop\VBA"

 Tree strDirName

End Sub



Sub Tree(actdir As String)

 Dim fname

 Dim i As Integer, j As Integer

 Dim subdirs() As String



 Call ShowDir(actdir)

 i = 0

 fname = Dir(actdir & "\*.*", vbDirectory)

 While fname <> ""

    If fname <> "." And fname <> ".." And (GetAttr(actdir & "\" & fname) And vbDirectory) = vbDirectory Then

       i = i + 1

       Redim Preserve subdirs(i)

       subdirs(i) = actdir & "\" & fname

    End If

    fname = Dir

 Wend

 For j = 1 To i

    Call Tree(subdirs(j))

 Next

 Redim subdirs(0)

End Sub



Private Sub ShowDir(actdir As String)

 Dim fname

 fname = Dir(actdir & "\*.*", vbDirectory)

 If fname <> "" Then

   Redim Preserve strDir(1 To Zeile)

   strDir(Zeile) = actdir

   Cells(Zeile, 11).Value = actdir

   Cells(Zeile, 12).Value = FileDateTime(actdir)

   Zeile = Zeile + 1

 End If

End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Gruß Uwe

Sehr lieb von euch, ich bedanke mich für die Mühe. Klappt 1A:)

Terades

Steffl

Kuwer

Terades