Dateien und Ordner auslesen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
UserForm MsgBox
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

Beiträge aus den Excel-Beispielen zum Thema "Dateien und Ordner auslesen"