WSH Howto

Also Michi!

Ich schreib hier mal eine kleines Beispiel. Als erstes mußt Du aber unter Projekt/Verweise die Bibliothek "Microsot Scripting Runtime" in Dein Programm einbinden, dann zwei CommandButtons und eine ListBox im Form1 erstellen und abschließend den Code pasten:


Option Explicit

'Globale Variablen
Private bCancel As Boolean
Private wshFSO  As Scripting.FileSystemObject

Private Sub Command1_Click()
    GetRoot "C:\"
End Sub

Public Sub GetRoot(ByVal strDrive As String)

    Dim wshRootFolders  As Scripting.Folders
    Dim wshRootFolder   As Scripting.Folder
    
On Error Resume Next

    'FileSystenObjekt erstellen
    Set wshFSO = New FileSystemObject
    'Erstes FoldersObjekt (Kollektion) erstellen
    Set wshRootFolder = wshFSO.GetFolder(strDrive)
    
    'Alle FolderObjekte in der Folders-Kollektion durchsuchen
    For Each wshRootFolder In wshRootFolders
        'Abruch erkennen
        DoEvents
        If bCancel Then Exit For
        'Filesuchprocedure aufrufen
        GetFiles wshRootFolder
        'Überprüfung auf Subdirectories
        If wshRootFolder.SubFolders.Count > 0 Then
            GetSub wshRootFolder
        End If
    Next wshRootFolder
    
    'Wichtig: Alle Objekt wieder terminieren!
    Set wshRootFolders = Nothing
    Set wshRootFolder = Nothing
    Set wshFSO = Nothing

End Sub

Public Sub GetSub(ByVal wshRoot As Scripting.Folder)

    Dim wshSubFolders As Scripting.Folders
    Dim wshSubFolder As Scripting.Folder

On Error Resume Next

    'Kollektion erstelleb
    Set wshSubFolders = wshRoot.SubFolders
    
    'Kollektion durchsuchen
    For Each wshSubFolder In wshSubFolders
        'Abruch erkennen
        DoEvents
        If bCancel Then Exit For
        'Filesuchprocedure aufrufen
        GetFiles wshSubFolder
        'Überprüfung auf Subdirectories
        If wshSubFolder.SubFolders.Count > 0 Then
            'Die Procedure ruft sich selbst auf
            GetSub wshSubFolder
        End If
    Next wshSubFolder
    
    'Objekttremination
    Set wshSubFolders = Nothing
    Set wshSubFolder = Nothing

End Sub


Private Sub GetFiles(ByVal wshFileFolder As Scripting.Folder)
    
    Dim wshFiles    As Scripting.Files
    Dim wshFile     As Scripting.File
    
On Error Resume Next
    
    'FilesObjekt (Kollektion) erstellen
    Set wshFiles = wshFileFolder.Files
    
    'Alle FileObjekte der FilesKollektion durchschreiten
    For Each wshFile In wshFiles
        'Abruch erkennen
        DoEvents
        If bCancel Then Exit For
        'Überprüfung des Fileattributes
        If wshFile.Attributes = Archive Then
            'Eintragung in die ListBox
            List1.AddItem wshFile.Name
        End If
    Next wshFile
    
    'Objekttermination
    Set wshFiles = Nothing
    Set wshFile = Nothing
    
End Sub

Private Sub Command2_Click()
    bCancel = True
End Sub

Viel Spaß, Stefan.