Attribute VB_Name = "Modul1"
Option Explicit
'
' Autor : R.Lippold
'
'---Globale--------------------------------------
Public z, unterordner As Variant
Public lw As String
Public summe As Double
Public anzahl As Double
'-------------------------------------------------
Sub alle_Dateien_ermitteln()
Dim zeile As Integer
Dim datei As String
Dim Pfad As String
Dim laufwerk, maske As String
'
lw = "C:"
lw = InputBox("Laufwerksbuckstabe ([Buchstabe][:])", "Laufwerk ", "C:")
'Dateiliste löschen
Sheets("Directory").Select
[a2:i50000] = ""
'Dateiliste anlegen
unterordner = vbYes
laufwerk = lw
maske = "*.*"
z = 2
Sheets("Directory").Select
Dateisuche laufwerk, maske
' Speicherbedarf prüfen
Sheets("Directory").Select
zeile = 2
summe = 0
While Trim(Cells(zeile, 1)) <> ""
    summe = Cells(zeile, 3) + summe
    zeile = zeile + 1
Wend
Columns("A:E").EntireColumn.AutoFit
anzahl = zeile - 2
MsgBox "Anzahl Dateien = " & anzahl & " / Speicherplatz " & summe / 1000000 & " MB "
End Sub
'
'---------------------------------------------------------
'
Sub Dateisuche(laufwerk, Dateien)
    ' Problem Versteckte Dateien werden nicht gefunden
    ' evtl. Fehler bei CD Direct 
    Dim temp, wdhlg, dateiname As String
    On Error Resume Next
    If Right(laufwerk, 1) <> "\" Then laufwerk = laufwerk & "\"
    temp = Dir(laufwerk & Dateien)
    Do While Len(temp)
        dateiname = laufwerk & temp
        Application.StatusBar = dateiname
        ' Protokoll
        Cells(z, 1).Select
        Cells(z, 1) = laufwerk  ' & temp
        Cells(z, 3) = FileLen(laufwerk & temp)
        Cells(z, 4) = FileDateTime(laufwerk & temp)
        Cells(z, 2) = temp
        Cells(z, 5) = GetAttr(dateiname)
        z = z + 1
        temp = Dir()
    Loop
    temp = Dir(laufwerk, vbDirectory)
    If unterordner = vbNo Then temp = ""
    Do While Len(temp)
        If (temp <> ".") And (temp <> "..") Then
            If (GetAttr(laufwerk & temp) And vbDirectory) = vbDirectory Then
                'hier wird ein neues Verzeichnis nach Dateien durchsucht
                Dateisuche laufwerk & temp, Dateien  'rekursiver Aufruf
                z = z - 1   '????
                wdhlg = Dir(laufwerk, vbDirectory)
                z = z + 1   '????
                Do While wdhlg <> temp
                    wdhlg = Dir()
                Loop
            End If
        End If
        temp = Dir()
    Loop
    On Error GoTo 0
    Application.StatusBar = False
End Sub