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
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
Zuletzt bearbeitet von einem Moderator: