verzeichnisse ermitteln



Excel-Version: 9.0 (Office 2000)
nach unten

Betrifft: verzeichnisse ermitteln
von: Josef
Geschrieben am: 26.05.2002 - 15:14:21

hallo excel-gemeinde,

ich möchte unterverzeichnisse eines laufwerkes ermitteln und in tabellenform dokumentieren. z.b. alle verzeichnisse auf d:\
toll wäre, wenn man die verzeichnisse in einer art baumstruktur anzeigen könnte ( wie der dos-befehl "tree").

bin für jede hilfe dankbar

Josef

nach oben   nach unten

Re: verzeichnisse ermitteln
von: Edgar Kälin
Geschrieben am: 26.05.2002 - 15:24:23

Folgende Prozeduren und Funktionen listen Dir Verzeichnnisse, Dateien etc. in einer Tabelle auf:

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Const MAX_PATH = 260

Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Sub DateilisteErstellen()
Dim Dateiliste, Zähler&, Pfad$, AnzahlDateien&
Dim Zähler1, Zielbereich(1 To 8), Überschrift
On Error GoTo Fehlerbehandlung
Pfad = c:\
Überschrift = Array("Datei", "Dos-Name", "Pfad", "Kompletter Pfad", _
"Erstellungszeitpunkt", "Letzter Zugriff", "Letzter Schreibzugriff", "Größe")
With Sheets("Liste")
.Cells.ClearContents
For Zähler1 = 1 To 8
.Cells(1, Zähler1) = Überschrift(Zähler1 - 1)
Next
AnzahlDateien = DurchlaufePfad(Pfad, Dateiliste)
Application.ScreenUpdating = True
For Zähler = 1 To AnzahlDateien
For Zähler1 = 1 To 8
Zielbereich(Zähler1) = Dateiliste(Zähler1, Zähler)
Next
.Range(.Cells(Zähler + 1, 1), .Cells(Zähler + 1, 8)) = Zielbereich
Next
End With
Fehlerbehandlung:
Application.ScreenUpdating = True
End Sub

Private Function DurchlaufePfad(ByVal Pfadname As String, Dateiliste, Optional Dateiindex As Long) As Long
Dim Suchhandle&, Rückgabewert1&, dummy
Dim Suchkriterium$, zeile&, Erstellungsdatum As Date
Dim Filedaten As WIN32_FIND_DATA
If Dateiindex = 0 Then Dateiindex = 1
dummy = TypeName(Dateiliste)
Select Case dummy
Case "Variant()"
If UBound(Dateiliste, 1) <> 8 Then
ReDim Dateiliste(1 To 8, 1 To 10000)
End If
Case "Empty"
ReDim Dateiliste(1 To 8, 1 To 10000)
Case Else
Exit Function
End Select
Pfadname = Trim(Pfadname)
If Right$(Pfadname, 1) = "\" Then
Suchkriterium = Pfadname & "*"
Else
Suchkriterium = Pfadname & "\*"
End If
zeile = Dateiindex
Filedaten.cAlternate = String(14, Chr(0))
Filedaten.cFileName = String(260, Chr(0))
Suchhandle = FindFirstFile(Suchkriterium, Filedaten)
Rückgabewert1 = Suchhandle
Do While Rückgabewert1 <> 0
Filedaten.cFileName = Left(Filedaten.cFileName, InStr(1, Filedaten.cFileName, Chr(0)) - 1)
Filedaten.cAlternate = Left(Filedaten.cAlternate, InStr(1, Filedaten.cAlternate, Chr(0)) - 1)
If Trim(Filedaten.cFileName) <> "." And Trim(Filedaten.cFileName) <> ".." Then
If Filedaten.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
zeile = DurchlaufePfad((Pfadname & "\" & Trim(Filedaten.cFileName)), Dateiliste, zeile)
End If
If zeile = UBound(Dateiliste, 2) Then ReDim Preserve Dateiliste(1 To 8, 1 To zeile + 1000)
Dateiliste(1, zeile) = Trim(Filedaten.cFileName)
Dateiliste(2, zeile) = Trim(Filedaten.cAlternate)
Dateiliste(3, zeile) = Pfadname
Dateiliste(4, zeile) = Pfadname & "\" & Dateiliste(1, zeile)
Dateiliste(5, zeile) = Zeitumwandlung(Filedaten.ftCreationTime)
Dateiliste(6, zeile) = Zeitumwandlung(Filedaten.ftLastAccessTime)
Dateiliste(7, zeile) = Zeitumwandlung(Filedaten.ftLastWriteTime)
Dateiliste(8, zeile) = Filedaten.nFileSizeLow
zeile = zeile + 1
End If
Filedaten.cAlternate = String(14, Chr(0))
Filedaten.cFileName = String(260, Chr(0))
Rückgabewert1 = FindNextFile(Suchhandle, Filedaten)
Loop
DurchlaufePfad = zeile
dummy = FindClose(Suchhandle)
End Function

Private Function Zeitumwandlung(Filezeit As FILETIME)
Dim S_Zeit As SYSTEMTIME
FileTimeToSystemTime Filezeit, S_Zeit
If S_Zeit.wYear >= 1900 Then
Zeitumwandlung = CDbl(DateSerial(S_Zeit.wYear, S_Zeit.wMonth, S_Zeit.wDay) + _
TimeSerial(S_Zeit.wHour, S_Zeit.wMinute, S_Zeit.wSecond))
Else
Zeitumwandlung = ""
End If
End Function


Mfg
Edgar

nach oben   nach unten

Re: verzeichnisse ermitteln
von: jinx
Geschrieben am: 26.05.2002 - 15:34:49

Moin, Josef,

schau Dir doch mal das Beispiel von Hans unter Dateinamen in Tabelle einlesen an...

cu
jinx

nach oben   nach unten

Formel1 und Excel vertragen sich nicht
von: jinx
Geschrieben am: 26.05.2002 - 15:36:59

Moin, Josef,

leider die Frage nicht genau gelesen.

cu
jinx


nach oben   nach unten

danke!!
von: Josef
Geschrieben am: 26.05.2002 - 15:54:43

hallo edgar,

ich bedanke mich für deine schnelle und umfangreiche antwort!
wünsch dir noch einen schönen sonntag

cu

josef


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "verzeichnisse ermitteln"