Dateinamen und Verzeichnisse auslesen (inkl. Unterordner)

kaya33

Grünschnabel
Hallo allerseits

Ich möchte per VBA Dateinamen und Verzeichnisse auslesen (inkl. Unterordner). Ich habe verschiedene Makros ausprobiert und schlussendlich dieses Makro unten soweit zusammengebastelt, dass es tut was ich möchte (siehe die Datei im Anhang). Nun möchte ich gerne diesen Code ein bisschen erweitern. Ich kriege es selber nicht hin.

Folgende Funktion möchte ich gerne noch haben:

Von den Dateien zusätzlich noch jeweils die Aenderungsdatum ausgelesen und unter der Spalte J (Dokumentdatum) eingefügt werden. Format: JJJJ
Für jeden Ordner sollte der Zeitraum anhand untergeordneten Dateien und/oder Unterordnern zusammengerechnet bzw. kumuliert und unter der Spalte I (Zeitraum) eingefügt werden. Format JJJJ-JJJJ (von/bis).

Ich bedanke mich ganz herzlich für jede Hilfe!

Beste Grüsse
Kaya


Visual Basic:
Sub DateienAuflisten()
'Hauptordner auflisten
Dim FileSystem As Object
Dim Unterordner
Dim Datei
Dim Zeile As Long
Dim Spalte As Long
Dim Ordner


  Set FileSystem = CreateObject("Scripting.FileSystemObject")
  Spalte = 1
  Zeile = 1
  [a2:l50000] = ""
' Ordner auswählen
  Ordner = GetFolder()
' Festen Ordner definieren
'  Ordner = "D:\..."  'Ordnerpfad einfügen
 
  If FileSystem.FolderExists(Ordner) Then
    Set Ordner = FileSystem.GetFolder(Ordner)
 
    With ActiveSheet.Cells(2, 1)
'     Ordner mit Pfad angeben
'      .Value = Ordner
'     nur Ordnernamen angeben
      .Value = Ordner.Name
'     Zellformatierung
      .Font.Bold = True
'     .Interior.Color = RGB(220, 220, 220)
      .Font.Size = 12
      .Font.Color = vbBlue
     
    End With
 
    For Each Datei In Ordner.Files
      Zeile = Zeile + 1
'     Dateiname mit Pfad wird aufgelistet
        ActiveSheet.Cells(Zeile, Spalte).Value = Datei.Name
'     Nur der Dateiname wird aufgelistet
'        ActiveSheet.Cells(Zeile, Spalte).Value = Datei.Name
'     Wenn mit Hyperlink zur Datei dann
'     ActiveSheet.Hyperlinks.Add ActiveSheet.Cells(Zeile, Spalte), Datei
    Next
 
    ListOrdner Ordner, Zeile, 2
  End If
 
End Sub

Sub ListOrdner(Ordner, Zeile, Spalte)
'Unterordner auflisten
Dim FileSystem As Object
Dim Unterordner
Dim Datei

  Set FileSystem = CreateObject("Scripting.FileSystemObject")

  If FileSystem.FolderExists(Ordner) Then
    Set Ordner = FileSystem.GetFolder(Ordner)
    For Each Unterordner In Ordner.Subfolders
  
      Zeile = Zeile + 1
    
      With ActiveSheet.Cells(Zeile, Spalte)
'     Ordner mit Pfad angeben
'        .Value = Unterordner
'     nur Ordnernamen angeben
        .Value = Unterordner.Name
'     Zellformatierung
        .Font.Bold = True
        .Font.Size = 12
        .Font.Color = vbBlue
'       .Interior.Color = RGB(220, 220, 220)
      End With
    
      For Each Datei In Unterordner.Files
        Zeile = Zeile + 1
'     Dateiname mit Pfad wird aufgelistet
        ActiveSheet.Cells(Zeile, Spalte).Value = Datei.Name
'     Nur der Dateiname wird aufgelistet
'        ActiveSheet.Cells(Zeile, Spalte).Value = Datei.Name
'     Wenn mit Hyperlink zur Datei dann
'     ActiveSheet.Hyperlinks.Add ActiveSheet.Cells(Zeile, Spalte), Datei
      Next
    
      ListOrdner Unterordner, Zeile, Spalte + 1
    Next
  End If
 
 
End Sub
Private Function GetFolder() As String
'Funktion um den Ordner auszuwählen
    Dim objShell As Object
    Dim strPath As String
    Set objShell = CreateObject("Shell.Application")
    Set varFolder = objShell.BrowseForFolder(0, "Folder", &H4000, 17)
    If varFolder Is Nothing Then
        Set varFolder = Nothing
        Set objShell = Nothing
        Exit Function
    End If
    GetFolder = varFolder.Self.Path
    Set objShell = Nothing
End Function
 

Anhänge

  • Test_Dateien auflisten.zip
    27,1 KB · Aufrufe: 3
Zuletzt bearbeitet von einem Moderator:
Du arbeitest ja mit dem FileSystemObject. Da hat das Objekt File die Eigenschaft .DateLastModified
Datei.DateLastModified

Zudem würde ich die Funktion ListOrdner() umschreiben, dass sie den Ordner und nicht den die Unterordner durchgeht.

Ungetestet
Visual Basic:
'ByVal und ByRef sind wichtig. 
'Bei ByVal wird der Wert übergeben. In der aufrufenden Sub wird der Wert nachher nicht geändert. 
'Bei ByRef wird eine Referenz übergeben. ändert sich der Wert un der aufgerufenen Sub, so ändert er sich auch in der Aufrufenden
Sub listOrdner(ordner, byval zeileNr, byval spalteNr, byRef oMinModifyDate As Date, byref oMaxModifyDate As Date)
  Dim fileSystem As Object
  Dim unterordnerObj
  Dim dateiObj
  Dim ordnerObj
  Dim minModifyDate As Date
  Dim maxModifyDate As Date
  Dim actFolderZieleNr As Long
 
  Set fileSystem = CreateObject("Scripting.fileSystemObject")

  If fileSystem.FolderExists(ordner) Then
    Set ordnerObj = fileSystem.GetFolder(ordner)
    actFolderZieleNr = zeileNr

    'Alles unterordnerObj abarbeiten
    For Each unterordnerObj In ordnerObj.Subfolders
      zeileNr = zeileNr +1
      ListOrdner unterordnerObj, zeileNr, spalteNr + 1, oMinModifyDate, oMaxModifyDate

      'Min/Max merken. Die Paramter die mit ByRef übergeben wurden, die beinhalten jetzt das Resultat des letzten Aufrufes der Funkton
      If minModifyDate > oMinModifyDate Then minModifyDate = oMinModifyDate
      If maxModifyDate < oMaxModifyDate Then maxModifyDate = oMaxModifyDate
    Next



    'Alle Files des Ordners durchgehen
    For Each dateiObj In ordnerObj.Files
      zeileNr = zeileNr + 1
      ActiveSheet.Cells(zeileNr, spalteNr).Value = dateiObj.Name
      'spalteNr J = 10
      ActiveSheet.Cells(zeileNr, 10).Value = dateiObj.DateLastModified
    
      'min und max abgleichen
      If minModifyDate > dateiObj.DateLastModified Then minModifyDate = dateiObj.DateLastModified
      If maxModifyDate < dateiObj.DateLastModified Then maxModifyDate = dateiObj.DateLastModified
    Next

    'Aktiver Ordner schrieben
    With ActiveSheet.Cells(actFolderZieleNr, actSpalteNr)
      .Value = unterordnerObj.Name
      .Font.Bold = True
      .Font.Size = 12
      .Font.Color = vbBlue
    End With
    ActiveSheet.Cells(actFolderZieleNr, 9).Value = year(minModifyDate) & "-" & year(maxModifyDate)

    'min und max zurückgeben
    oMinModifyDate = minModifyDate
    oMaxModifyDate = maxModifyDate



  End If
End Sub
 
Du arbeitest ja mit dem FileSystemObject. Da hat das Objekt File die Eigenschaft .DateLastModified
Datei.DateLastModified

Zudem würde ich die Funktion ListOrdner() umschreiben, dass sie den Ordner und nicht den die Unterordner durchgeht.

Ungetestet
Visual Basic:
'ByVal und ByRef sind wichtig.
'Bei ByVal wird der Wert übergeben. In der aufrufenden Sub wird der Wert nachher nicht geändert.
'Bei ByRef wird eine Referenz übergeben. ändert sich der Wert un der aufgerufenen Sub, so ändert er sich auch in der Aufrufenden
Sub listOrdner(ordner, byval zeileNr, byval spalteNr, byRef oMinModifyDate As Date, byref oMaxModifyDate As Date)
  Dim fileSystem As Object
  Dim unterordnerObj
  Dim dateiObj
  Dim ordnerObj
  Dim minModifyDate As Date
  Dim maxModifyDate As Date
  Dim actFolderZieleNr As Long
 
  Set fileSystem = CreateObject("Scripting.fileSystemObject")

  If fileSystem.FolderExists(ordner) Then
    Set ordnerObj = fileSystem.GetFolder(ordner)
    actFolderZieleNr = zeileNr

    'Alles unterordnerObj abarbeiten
    For Each unterordnerObj In ordnerObj.Subfolders
      zeileNr = zeileNr +1
      ListOrdner unterordnerObj, zeileNr, spalteNr + 1, oMinModifyDate, oMaxModifyDate

      'Min/Max merken. Die Paramter die mit ByRef übergeben wurden, die beinhalten jetzt das Resultat des letzten Aufrufes der Funkton
      If minModifyDate > oMinModifyDate Then minModifyDate = oMinModifyDate
      If maxModifyDate < oMaxModifyDate Then maxModifyDate = oMaxModifyDate
    Next



    'Alle Files des Ordners durchgehen
    For Each dateiObj In ordnerObj.Files
      zeileNr = zeileNr + 1
      ActiveSheet.Cells(zeileNr, spalteNr).Value = dateiObj.Name
      'spalteNr J = 10
      ActiveSheet.Cells(zeileNr, 10).Value = dateiObj.DateLastModified
   
      'min und max abgleichen
      If minModifyDate > dateiObj.DateLastModified Then minModifyDate = dateiObj.DateLastModified
      If maxModifyDate < dateiObj.DateLastModified Then maxModifyDate = dateiObj.DateLastModified
    Next

    'Aktiver Ordner schrieben
    With ActiveSheet.Cells(actFolderZieleNr, actSpalteNr)
      .Value = unterordnerObj.Name
      .Font.Bold = True
      .Font.Size = 12
      .Font.Color = vbBlue
    End With
    ActiveSheet.Cells(actFolderZieleNr, 9).Value = year(minModifyDate) & "-" & year(maxModifyDate)

    'min und max zurückgeben
    oMinModifyDate = minModifyDate
    oMaxModifyDate = maxModifyDate



  End If
End Sub

Vielen herzlichen Dank. Ich werde es mal testen. Habe ich es richtig verstanden? Muss ich nur Sub listordner () erstzen?

Beste Grüsse
 
Bin noch mal drüber gegangen.
1) kleine Erweiterungen:
Neue Funktion NZ()
Visual Basic:
Function NZ(ByRef iValue As Variant, Optional ByRef iDefault As Variant = Empty) As Variant
  If IsNull(iValue) Then
    NZ = iDefault
  Else
    NZ = iValue
  End If
End Function
Anpassung meiner Funktion
Visual Basic:
Sub listOrdner(ordner, byval zeileNr, byval spalteNr, optional byRef oMinModifyDate As Date = null, optional byref oMaxModifyDate As Date = null)
....
  'modfy Date setzen im Ordner-Loop
      If minModifyDate >= NZ(oMinModifyDate, minModifyDate) Then minModifyDate = oMinModifyDate
      If maxModifyDate <= NZ(oMaxModifyDate, maxModifyDate) Then maxModifyDate = oMaxModifyDate
...

Dann kannst du die Datei-Schleife in DateienAuflisten schrotten.
Visual Basic:
If FileSystem.FolderExists(Ordner) Then
  Set Ordner = FileSystem.GetFolder(Ordner)
  ListOrdner Ordner, Zeile, 2
End If
 
und Bin noch mal drüber gegangen.
1) kleine Erweiterungen:
Neue Funktion NZ()
Visual Basic:
Function NZ(ByRef iValue As Variant, Optional ByRef iDefault As Variant = Empty) As Variant
  If IsNull(iValue) Then
    NZ = iDefault
  Else
    NZ = iValue
  End If
End Function
Anpassung meiner Funktion
Visual Basic:
Sub listOrdner(ordner, byval zeileNr, byval spalteNr, optional byRef oMinModifyDate As Date = null, optional byref oMaxModifyDate As Date = null)
....
  'modfy Date setzen im Ordner-Loop
      If minModifyDate >= NZ(oMinModifyDate, minModifyDate) Then minModifyDate = oMinModifyDate
      If maxModifyDate <= NZ(oMaxModifyDate, maxModifyDate) Then maxModifyDate = oMaxModifyDate
...

Dann kannst du die Datei-Schleife in DateienAuflisten schrotten.
Visual Basic:
If FileSystem.FolderExists(Ordner) Then
  Set Ordner = FileSystem.GetFolder(Ordner)
  ListOrdner Ordner, Zeile, 2
End If
Hallo Yaslaw

Erstmal vielen vielen dank für deine Bemühungen und deine Inputs. Es sieht vielversprechend aus. Ich konnte leider dein Code noch nicht laufen bringen. Ich bin total überfordert, wie ich alles zusammensetzen soll, damit es lauft. Dein Code alleine wird nicht als Makro erkannt! Ich hatte versucht ihn zu integrieren, erhielt aber ich nur Fehlermeldungen. Ich schaffe es einfach nicht!

Herzliche Grüsse
Kaya
 
Zurück