[Source] Eliminar carpetas, subcarpetas y archivos

[nhaalclkiemr]

Weno pues he hecho una funcion sencilla para borrar carpetas y sus archivos, con la posibilidad de eliminar sus subcarpetas. La funcion devolverá 0 si no se consiguió eliminar a carpeta original, si la carpeta se consiguó eliminar correctamente devolverá un valor distinto de 0. Fijate en que para borrar una carpeta primero hay que borrar todos sus archivos, si cualquier archivo de cualquier subcarpeta no se consiguió eliminar (por ejemplo por estár en uso) no se podrá borrar la carpeta original y la funcion devolverá 0, aunke puede que borrase la mayor parte de los archivos igualmente...

Si seleccionas eliminar las subcarpetas (que es lo normal) se borrarán todos los archivos y subcarpetas de la misma, y por ultimo se borra tambien la carpeta.

Si no seleccionas borrar las subcarpetas solamente se borran los archivos de la carpeta elegida y posteriormente se intenta borrar la carpeta, pero si existen subcarpetas está nunca se conseguirá eliminar (ya que hay subcarpetas dentro) y la funcion devolverá un valor distinto de 0.

Weno hice dos funciones, una usando las APIs y otra usando las funciones de VB:

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Private Declare Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long

Public Function ElimFolder(ByVal sDir As String, ByVal WithSubfolders As Boolean) As Long
Dim sFile As String
Dim counD As Long, counF As Long
Dim i As Long
ReDim sDirs(0 To 0) As String
ReDim sFiles(0 To 0) As String
On Error Resume Next
If IsDir(sDir) Then
    If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
    sFile = Dir(sDir, 55)
    Do
        If IsDir(sDir & sFile) Then
            If (sFile <> ".") And (sFile <> "..") Then
                ReDim Preserve sDirs(0 To counD) As String
                sDirs(counD) = sDir & sFile
                counD = counD + 1
            End If
        Else
            ReDim Preserve sFiles(0 To counF) As String
            sFiles(counF) = sFile
            counF = counF + 1
        End If
        sFile = Dir
    Loop While sFile <> vbNullString
    If sFiles(0) <> vbNullString Then
        For i = 0 To UBound(sFiles)
            DeleteFile sDir & sFiles(i)
        Next i
    End If
    If WithSubfolders Then
        If sDirs(0) <> vbNullString Then
            For i = 0 To UBound(sDirs)
                ElimFolder sDirs(i), True
            Next i
        End If
    End If
    ElimFolder = RemoveDirectory(sDir)
End If
End Function

Código (vb) [Seleccionar] Expandir

Option Explicit

Public Function ElimFolder(ByVal sDir As String, ByVal WithSubfolders As Boolean) As Long
Dim sFile As String
Dim counD As Long, counF As Long
Dim i As Long
ReDim sDirs(0 To 0) As String
ReDim sFiles(0 To 0) As String
On Error Resume Next
If IsDir(sDir) Then
    If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
    sFile = Dir(sDir, 55)
    Do
        If IsDir(sDir & sFile) Then
            If (sFile <> ".") And (sFile <> "..") Then
                ReDim Preserve sDirs(0 To counD) As String
                sDirs(counD) = sDir & sFile
                counD = counD + 1
            End If
        Else
            ReDim Preserve sFiles(0 To counF) As String
            sFiles(counF) = sFile
            counF = counF + 1
        End If
        sFile = Dir
    Loop While sFile <> vbNullString
    If sFiles(0) <> vbNullString Then
        For i = 0 To UBound(sFiles)
            Kill sDir & sFiles(i)
        Next i
    End If
    If WithSubfolders Then
        If sDirs(0) <> vbNullString Then
            For i = 0 To UBound(sDirs)
                ElimFolder sDirs(i), True
            Next i
        End If
    End If
    Err.Clear
    RmDir sDir
    If Err.Number = 0 Then ElimFolder = 1
End If
End Function

Son codes sencillos pero espero que les sirvan a alguien.

Saludos

[~~]

Vaya racha de sources xDD te ls pongo en la biblioteca todos

[Chefito]

Gran trabajo nhaalclkiemr. Solo una puntualización,¿IsDir() es una función creada por ti?....como no la has puesto  .
Sería por ejemplo algo asi no?

Código [Seleccionar] Expandir

Public Function IsDir(Directorio as string) as boolean
   if len(Dir(Directorio,vbDirectory))<>0 then IsDir=true else IsDir=false
End Function
Corrigeme si me he equivocado.
Saludos.

[Chefito]

Por cierto, otra forma de borrarlos:

Código [Seleccionar] Expandir

Private Function BorrarDirectorio(Directorio As String) As Boolean
    On Error GoTo nodirectorio
    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.DeleteFolder Directorio
    BorrarDirectorio = True
    Exit Function
nodirectorio:
    BorrarDirectorio = False
End Function

Le puedes meter la función isdir para obligarlo aun mas a que sea un directorio . Vamos....esto solo sería la base de una función. Da false si ocurre algun error y no puede borrarlo y true si lo borrar.
Saludos.
P.D. Esto se carga el directorio con todo su contenido dentro. Para hacerlo igual que nhaalclkiemr, tendríamos que currarnoslo más, y no tengo ganas . A ver si alguien se anima. Por cierto........no sobrevivió el comando deltree de msdos?