Herbers Excel-Forum - das Archiv

Dateien und Ordner auslesen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Dateien und Ordner auslesen
von: Martin

Geschrieben am: 08.04.2005 08:09:18
Hallo und guten Morgen!
Ich habe in der Recherche einiges zum Thema Dateien auslesen gefundn, allerdings nicht das, was ich jetzt benötige. Kann mir jemand helfen?
Ich möchte gerne ein komplettes Laufwerk (Beispielsweise C: oder N: durchsuchen und im Prinzip eine Ordnungsstruktur mit allesn Ordnern, Unterordnern und Dateien (Word, Excel, PDF, Powerpoint) mit Namen und Größe [und am besten auch Datum der letzten Änderung(nicht so wichtig!)] aufzeigen lassen. Diese will ich anschließend ausdrucken.

Vielen Dank
Martin
Bild

Betrifft: AW: Dateien und Ordner auslesen
von: ottoh
Geschrieben am: 08.04.2005 08:21:31
Hallo MArtin,
schau' mal hier nach, ob das was für Dich ist:
http://www.add-in-world.com/katalog/xl-dateilister/

Gruß OttoH
Bild

Betrifft: AW: Dateien und Ordner auslesen
von: Martin

Geschrieben am: 08.04.2005 08:54:37
Hallo OttoH,
vielen Dank für den Vorschlag, habe ihn auch sofort ausprobiert, allerdings reicht mir das nicht. Ich bekomme gleich die Meldung, daß er nur 100 Ordner und 1000 Dateien berücksichtigt. Damit komm ich nicht hin. Habe bei weiterem mehr von beiden. Hast Du vielleicht sonst noch eine Idee?

Danke,
Martin
Bild

Betrifft: AW: Dateien und Ordner auslesen
von: ottoh

Geschrieben am: 08.04.2005 08:58:11
Hallo Martin,
mehr fällt mir auch nicht ein. Ich lese immer nur einen bestimmte Ordner ein. Den Dateilister aus Add-In-World habe ich auch noch nicht soweit getrieben, dass er an seine Grenzen gestoßen ist.
Gruß OttoH
Bild

Betrifft: AW: Dateien und Ordner auslesen
von: Rolf Beißner

Geschrieben am: 08.04.2005 09:42:21
Hallo Martin,
hier eine nicht besonders komfortable Variante -
schau mal, ob sie dir trotzdem reicht.
Läuft bei mir ca. 4 Min. bei 24.000 Dateien.
fG
Rolf
Option Explicit
Sub dateien_ausgeben()
'Rolf Beißner
Dim fs As Object
Dim fso As Object
Dim i As Integer, n As Integer
Dim A As Variant
A = Array("Pfad", "Datei", "LastModify")
ActiveWorkbook.Sheets.Add
With Range("A1:C1")
.Value = A
.Interior.ColorIndex = 15
.Font.Bold = True
End With
Application.ScreenUpdating = False
Set fs = CreateObject("Scripting.FileSystemObject")
Set fso = Application.FileSearch
With fso
.NewSearch
.LookIn = "C:\"             'Laufwerk ggfs. ändern
.Filename = "*.*"
.SearchSubFolders = True
If .Execute() > 0 Then
n = .FoundFiles.Count
MsgBox n & " Datei(en) gefunden"
For i = 1 To n
Cells(i + 1, 1) = fs.GetParentFolderName(.FoundFiles(i))
Cells(i + 1, 2) = fs.GetFileName(.FoundFiles(i))
Cells(i + 1, 3) = fs.GetFile(.FoundFiles(i)).DateLastModified
Next i
End If
End With
Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Bild

Betrifft: AW: Dateien und Ordner auslesen
von: Martin

Geschrieben am: 08.04.2005 10:36:58
Hallo Rolf,
hat leider nicht so ganz geklappt. Da hat sich Excel bei mir aufgehängt. Trotzdem Danke!!
Habe aber dann doch noch was gefunden was mir hilft:
Public Sub Searching_files()
Dim myFileSystemObject As New FileSystemObject, myFile As File, myFileSearch As FileSearch
Dim strName() As String, strPath() As String, strPath_old As String
Dim lngIndex As Long, lngRow As Long, lngCount As Long, lngFolder As Long, lngStart As Long
Dim intColumn As Integer
Cells.Clear
Application.ScreenUpdating = False
Set myFileSearch = Application.FileSearch
With myFileSearch
.LookIn = strDrive
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.Execute
On Error Resume Next
For lngIndex = 1 To .FoundFiles.Count
Set myFile = myFileSystemObject.GetFile(.FoundFiles(lngIndex))
If Err.Number = 0 Then
If Left$(myFile.ParentFolder, 1) = Left$(strDrive, 1) Then
lngCount = lngCount + 1
ReDim Preserve strName(1 To lngCount)
ReDim Preserve strPath(1 To lngCount)
strName(lngCount) = myFile.Name
strPath(lngCount) = myFile.ParentFolder
End If
End If
Err.Clear
Next
On Error GoTo 0
End With
Set myFile = Nothing
Set myFileSearch = Nothing
Call Arrange(1, lngCount, strName, strPath)
lngRow = 1
intColumn = 1
Call Heading(1)
For lngIndex = 1 To lngCount
If strPath_old <> strPath(lngIndex) Then
If lngRow > 1 Then Range(Cells(lngStart, intColumn), Cells(lngRow, intColumn)).Sort Key1:=Cells(lngStart, intColumn)
Call Row_control(lngRow, intColumn, 3)
With Cells(lngRow, intColumn)
.Value = strPath(lngIndex)
.Font.Bold = True
End With
lngFolder = lngFolder + 1
strPath_old = strPath(lngIndex)
Call Row_control(lngRow, intColumn, 1)
lngStart = lngRow + 1
End If
Call Row_control(lngRow, intColumn, 1)
Cells(lngRow, intColumn) = strName(lngIndex)
Next
Range(Cells(lngStart, intColumn), Cells(lngRow, intColumn)).Sort Key1:=Cells(lngStart, intColumn)
Call Row_control(lngRow, intColumn, 3)
With Cells(lngRow, intColumn)
.Value = "Dateien Gesamt: " & CStr(lngCount)
.Font.Bold = True
End With
Call Row_control(lngRow, intColumn, 1)
With Cells(lngRow, intColumn)
.Value = "Ordner Gesamt: " & CStr(lngFolder)
.Font.Bold = True
End With
Columns.AutoFit
Unload UserForm2
Application.ScreenUpdating = True
End Sub
Private Sub Arrange(lngBase_limit As Long, lngUpper_limit As Long, strName() As String, strPath() As String)
Dim lngIndex1 As Long, lngIndex2 As Long, strElement1 As String, strElement2 As String, strBuffer As String
lngIndex1 = lngBase_limit
lngIndex2 = lngUpper_limit
strBuffer = strPath(Fix(lngBase_limit + lngUpper_limit) / 2)
Do
Do While strPath(lngIndex1) < strBuffer
lngIndex1 = lngIndex1 + 1
Loop
Do While strBuffer < strPath(lngIndex2)
lngIndex2 = lngIndex2 - 1
Loop
If lngIndex1 <= lngIndex2 Then
strElement1 = strName(lngIndex1)
strElement2 = strPath(lngIndex1)
strName(lngIndex1) = strName(lngIndex2)
strPath(lngIndex1) = strPath(lngIndex2)
strName(lngIndex2) = strElement1
strPath(lngIndex2) = strElement2
lngIndex1 = lngIndex1 + 1
lngIndex2 = lngIndex2 - 1
End If
Loop Until lngIndex1 > lngIndex2
If lngBase_limit < lngIndex2 Then Call Arrange(lngBase_limit, lngIndex2, strName, strPath)
If lngIndex1 < lngUpper_limit Then Call Arrange(lngIndex1, lngUpper_limit, strName, strPath)
End Sub

Private Sub Row_control(lngRow As Long, intColumn As Integer, bytCount As Byte)
lngRow = lngRow + bytCount
If lngRow > 65536 Then
lngRow = 1
intColumn = intColumn + 1
Call Heading(intColumn)
End If
End Sub

Private Sub Heading(intColumn As Integer)
With Cells(1, intColumn)
.Value = "Files on Drive: " & Left$(strDrive, 1)
With .Font
.Size = 12
.Bold = True
End With
End With
End Sub


Grüße,
Martin
 Bild
Excel-Beispiele zum Thema "Dateien und Ordner auslesen"
Alle Dateien im Verzeichnis öffnen Dateien listen
400 leere Textdateien anlegen XL-Dateien in UserForm listen
XL5/7-Dateien nach XL8 konvertieren Dateien aus Listbox auslesen und öffnen
Excel-Dateien eines Ordners listen Alle Dateien ab einem bestimmten Datum listen
Alle Dateien eines Verzeichnisses drucken Textdateien verbinden