VBA: Ordner auflisten mit Moddate (halb gelöst)

[Terades]

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

[Steffl]

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

[Kuwer]

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

[Terades]

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