Ordner und Dateien auslesen

[wOp]

Benötige kurze Hilfestellung!

Ich möchte mir alle Unterordner und die darin befindlichen Dateien anzeigen lassen. Ein kleines Code Beispiel wäre fein. Danke

Beispiel:
Ordner1
- Unterordner1
-Datei1
-Datei2
- Unterordner2
-Datei1
-Datei2

 

[Backdraft]

Tag,

googlen macht Spaß. 5 Sek.

'Dieser Source stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------

'Control CheckBox: Check1
'Control DriveListBox: Drive1
'Control DirListBox: Dir1
'Control TextBox: Text2
'Control TextBox: Text1
'Control CommandButton: Command1
'Control ListBox: List1
'Control Label: Label6
'Control Label: Label5
'Control Label: Label4
'Control Label: Label3
'Control Label: Label2
'Control Label: Label1



'Dank an Lothar Kriegerow für die Verwirklichung der Filter-
'funktion.

Option Explicit

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 FindClose Lib "kernel32" (ByVal _
        hFindFile As Long) As Long

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Const MAX_PATH = 259

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

Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100



Private Sub Dir1_Change()
Text1.Text = Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub


Private Sub Form_Load()
  Text1.Text = Dir1.Path
  Text2.Text = "*.*"
End Sub

Private Sub Command1_Click()
  Dim Files() As String, X&, Such$
  Dim DatCnt%, DirCnt%
  Such$ = Trim$(UCase$(Text2.Text))
  If Left$(Such$, 1) = "*" Then Such$ = Right$(Such$, Len(Such$) -  _
  InStr(Such$, "."))
    ReDim Files(0 To 0)
    MousePointer = 11
    DoEvents
    Call GetAllFiles(Text1.Text, Such$, Files)
    MousePointer = 0
    DoEvents
    List1.Clear
    For X = 0 To UBound(Files) - 1
      List1.AddItem Files(X)
      If Left$(Files(X), 2) = ">>" Then
        DirCnt = DirCnt + 1
        Label5.Caption = DirCnt
        Label5.Refresh
      Else
        DatCnt = DatCnt + 1
        Label6.Caption = DatCnt
        Label6.Refresh
      End If
    Next X
End Sub

Private Sub GetAllFiles(ByVal Root$, ByVal Such$, ByRef Field$())
  Dim File$, hFile&, FD As WIN32_FIND_DATA
DoEvents
    If Right(Root, 1) <> "\" Then Root = Root & "\"
    hFile = FindFirstFile(Root & "*.*", FD)
    If hFile = 0 Then Exit Sub
    Do
       File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)
       If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
         = FILE_ATTRIBUTE_DIRECTORY Then
         If (File <> ".") And (File <> "..") Then
         'Verz.: ">>" kann entfernt werden,da nur zur Visualisierung
          
          If Check1.Value Then
           Field(UBound(Field)) = ">>" & Root & File
           ReDim Preserve Field(0 To UBound(Field) + 1)
          End If
           GetAllFiles Root & File, Such$, Field
         End If
       Else
         'Datei: "    " kann entfernt werden,da nur zur Visualisierung
         If Such$ = Right$(UCase$(File), Len(Such$)) Or Such$ = "*" Then
         Field(UBound(Field)) = "    " & Root & File
         ReDim Preserve Field(0 To UBound(Field) + 1)
         End If
       End If
    Loop While FindNextFile(hFile, FD)
    Call FindClose(hFile)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------