Auslesen von Dateiverzeichnis und Namen

Hallo,
ich habe vorhin vesucht ein passendes Beispiel im Archiv zu finden, aber leider ohne Erfolg! Und zwar suche ich ein Makro, welches ab einen Bestimmten Dateiordner sämtliche Unterordner (am besten in verschiedenden Spalten) auflistet und dazu aus der jeweils untersten Ordnerhierachie sämtliche Dateinamen sowie das entsprechende Aktualisierungsdatum auflistet.
Hintergrund ist derjenenige, dass ich im Augenblick ein Archiv aufbaue, welches sukzessive mit Daten gefüllt wird und schnell, unkompliziert wie auch vollständig zur Kontrolle und besseren Übersicht die Inhalte auflisten möchte.
Hat hier einer von euch eine Idee oder weiss, ob so ein ähnliches Problem bereits schon einmal diskutiert wurde?
Grüße
Christian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
mal als Ansatz:
prcFileListe starten


Option Explicit
Dim wksInhalt As Worksheet, vntFiles(), lngFiles As Long
Sub prcFileListe()
Dim FSO As Object, oFolder As Object
Dim strFolder As String
Application.ScreenUpdating = False
strFolder = fncFolderName
If strFolder = "" Then Exit Sub 'Abbruch
Set FSO = CreateObject("Scripting.FileSystemObject")
Set wksInhalt = Workbooks.Add.Sheets(1)
Set oFolder = FSO.GetFolder(strFolder)
lngFiles = 1
With wksInhalt
.Cells(1, 1) = "Pfad"
.Cells(1, 2) = "kB"
.Cells(1, 3) = "le.Änd."
.Cells(1, 4) = "erstellt"
.Rows(1).Font.Bold = True
End With
prcFiles oFolder
prcSubFolders oFolder
With wksInhalt
.Range(.Cells(2, 1), .Cells(lngFiles, 4)) = WorksheetFunction.Transpose(vntFiles)
With .Columns("B:D")
.Font.ColorIndex = xlAutomatic
.Font.Underline = xlUnderlineStyleNone
End With
Columns("B").NumberFormat = "#,##0.00"
.Columns("C:D").NumberFormat = "DD.MM.YYYY hh:mm:ss"
.Columns.AutoFit
.Activate
End With
Application.ScreenUpdating = True
End Sub
Private Sub prcSubFolders(oFolder)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.subfolders
prcFiles oSubFolder
prcSubFolders oSubFolder
Next
End Sub
Private Sub prcFiles(oFolder)
Dim oFile As Object
For Each oFile In oFolder.Files
ReDim Preserve vntFiles(1 To 4, 1 To lngFiles)
vntFiles(1, lngFiles) = "=hyperlink(" & Chr(34) & oFile.Path & Chr(34) & ")"
vntFiles(2, lngFiles) = oFile.Size / 1024
vntFiles(3, lngFiles) = Format(oFile.datelastmodified, "DD.MM.YYYY hh:mm:ss")
vntFiles(4, lngFiles) = Format(oFile.datecreated, "DD.MM.YYYY hh:mm:ss")
'        vntFiles(5, lngFiles) = oFile.datelastaccessed
lngFiles = lngFiles + 1
Next
End Sub
Private Function fncFolderName() As String
'ab Version 2000:
Dim strFolder As String
With Application.FileDialog(4)
.InitialFileName = "C:\"
.InitialView = 2
If .Show = -1 Then
fncFolderName = .SelectedItems(1)
'MsgBox strFolder 'Pfad des ausgewählten Ordners
End If
End With
End Function

Gruß ausm Pott
Udo

Beliebteste Forumthreads (12 Monate)

Auslesen von Dateiverzeichnis und Namen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Auslesen von Dateiverzeichnis und Namen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread