Cancellazione di una cartella e di tutte le cartelle collegate (clone Deltree)

Routine di cancellazione di una cartella e di tutte le cartelle collegate (clone Deltree).

1° Esempio:

Option Explicit

Public Sub DeleteFolderTree(ByVal vFolder As String)
    Dim FSO
    Dim FoldersObj
    Dim FolderObj
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(vFolder) Then
        Set FSO = Nothing
        Exit Sub
    End If
    Set FolderObj = FSO.GetFolder(vFolder)
    Set FoldersObj = FolderObj.SubFolders
    For Each FolderObj In FoldersObj
        DeleteFolderTree FolderObj.Path
    Next FolderObj

    On Error Resume Next

    'inserire la riga successiva se si vuole cancellare
    'anche i file contenuti dentro le directory e subdirectory
    '     Kill vFolder & "\*.*"

    RmDir vFolder

    Err.Clear
    On Error GoTo 0

    Set FolderObj = Nothing
    Set FoldersObj = Nothing
    Set FSO = Nothing
End Sub

Private Sub Command1_Click()
    DeleteFolderTree "d:\francoar\funzioni\"
End Sub

Testato su: Windows 98, Windows Me, Windows 2000 Professional

2° Esempio:

Option Explicit

Public Sub KillFolderTree(sFolder As String)
    Dim sCurrFilename As String
    sCurrFilename = Dir(sFolder & "\*.*", vbDirectory)
    Do While sCurrFilename <> ""
        If sCurrFilename <> "." And sCurrFilename <> ".." Then
            If (GetAttr(sFolder & "\" & sCurrFilename) And vbDirectory) = vbDirectory Then
                Call KillFolderTree(sFolder & "\" & sCurrFilename)
                sCurrFilename = Dir(sFolder & "\*.*", vbDirectory)
                'inserire queste due righe se si vuole cancellare anche i file
                'contenuti dentro le directory e subdirectory
            'Else
                ' Kill sFolder & "\" & sCurrFilename
            End If
        End If
        sCurrFilename = Dir
    Loop
    On Error Resume Next
    RmDir sFolder
End Sub

Private Sub Command1_Click()
    KillFolderTree "d:\francoar\funzioni\"
End Sub

Testato su: Windows 98, Windows Me, Windows 2000 Professional