Startseite / Tipps / VB 5/6-Tipp 0558: Deltree-Funktion

VB 5/6-Tipp 0558: Deltree-Funktion

 von NoOne

'Dieser Quellcode 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 Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"

'
'Autor:  NoOne <noone@aon.at>

Option Explicit

Private Sub DelTree(sFolder As String)
    Dim sCurrFile As String
    
    ' Variable mit der Pfadangabe füllen
    sCurrFile = Dir(sFolder & "\*.*", vbDirectory)
    
    ' Prüfen ob Verzeichniss vorhanden
    Do While Len(sCurrFile) > 0
        
        ' Wenn noch Dateien oder Unterordner vorhanden sind
        If sCurrFile <> "." And sCurrFile <> ".." Then
        
            ' Wenn es sich dabei um einen Unterordner handelt
            If (GetAttr(sFolder & "\" & sCurrFile) And vbDirectory) = _
                vbDirectory Then
                
                ' Unterordner löschen
                Call DelTree(sFolder & "\" & sCurrFile)
                
                ' Nächster Eintrag (Datei, Unterordner, ...)
                sCurrFile = Dir(sFolder & "\*.*", vbDirectory)
            
            ' Wenn nicht Ordner, sondern Datei
            Else
            
                ' diese Datei löschen
                Kill sFolder & "\" & sCurrFile
                sCurrFile = Dir
            End If
            
        ' Wenn Keine Einträge mehr vorhanden
        Else
    
            ' Variable zurücksetzen
            sCurrFile = Dir
        End If
        
    ' Wiederholen bis Ordner komplett leer
    Loop
    
    ' Am Ende noch den Ordner selber löschen
    RmDir sFolder
    
End Sub


Private Sub Command1_Click()
    Dim res
    
    res = MsgBox("Warnung! Alle Dateien und Unterordner des Pfades " _
            & Text1.Text & " werden gelöscht! Fortfahren?", vbOKCancel)
    If res = 1 Then
        DelTree (Text1.Text)  ' Aufruf der Funktion DelTree
    End If
End Sub


'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version: VB6 VB5 VB4

Windows-Version: Windows XP Windows 2000 Windows NT4 Windows Me Windows 98 Windows 95 Win32s

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 5 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Option Explicit

Public Sub DelTree(sFolder As String)
    Dim sCurrFile As String
    
    ' Variable mit der Pfadangabe füllen
    sCurrFile = Dir(sFolder & "\*.*", vbDirectory)
    Kill sFolder & "\*.*"
    
    ' Prüfen ob Verzeichniss vorhanden
    Do While Len(sCurrFile) > 0
        ' Wenn noch Dateien oder Unterordner vorhanden sind
        If sCurrFile <> "." And sCurrFile <> ".." Then
        
            ' Wenn es sich dabei um einen Unterordner handelt
            If (GetAttr(sFolder & "\" & sCurrFile) And vbDirectory) = _
                vbDirectory Then
                
                ' Unterordner löschen
                Call DelTree(sFolder & "\" & sCurrFile)
                
                ' Nächster Eintrag (Datei, Unterordner, ...)
                sCurrFile = Dir(sFolder & "\*.*", vbDirectory)
            
            ' Wenn nicht Ordner, sondern Datei
            End If
            
        ' Wenn Keine Einträge mehr vorhanden
        Else
    
            ' Variable zurücksetzen
            sCurrFile = Dir
        End If
        
    ' Wiederholen bis Ordner komplett leer
    Loop
    
    ' Am Ende noch den Ordner selber löschen
    RmDir sFolder
    
End Sub