Funciones Recursivas (Copiar, Mover y Borrar)

Debido a que no existe un comando parecido al DelTree, pues he tenido que construírmela, esto hace lo mismo. Es un buen ejemplo de función recursiva, solo hay que pasarle el directorio a borrar y borra todos los directorios que existan en él.

Partiendo de la base de esta función, se puede construir otras funciones como Copiar (XCopy), Mover o Contar los ficheros, directorios existentes en una estructura. Si quieres más información sobre estas otras funciones deja tu información en las observaciones del post.

Const ATTR_DIRECTORY = 16

Sub Borrar_Estructura(Directorio As String)
     Dim DirName, D() As String, I As Integer

     Directorio = AñadirBarra(Directorio)
     DirName = Dir(Directorio, ATTR_DIRECTORY)
     I = 0
     Do
          If DirName  "." And DirName  ".." Then
               If (GetAttr(Directorio + DirName) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
                    I = I + 1
                    ReDim Preserve D(I)
                    D(I) = DirName
               Else
                    Kill Directorio & DirName
               End If
          End If
          DirName = Dir
     Loop Until DirName = ""
     For I = 1 To I
          Borrar_Estructura Directorio & D(I)
     Next I
     RmDir Directorio
End Sub

Esta función Copia y/o Mueve (Borrar = True) un directorio completo, incluyendo todos sus subdirectorios.

Sub Copiar_Directorio(Origen As String, Destino As String, Optional Borrar As Boolean = False)
    Dim Count As Integer, D() As String, I As Integer, DirName
    Dim AntFichero As String, NewFichero As String
        
    On Error Resume Next
    Destino = AñadirBarra(Destino)
    Origen = AñadirBarra(Origen)
    DirName = Dir(Origen, ATTR_DIRECTORY)
    Do While DirName  ""
        If DirName  "." And DirName  ".." Then
            If (GetAttr(Origen + DirName) And ATTR_DIRECTORY) = ATTR_DIRECTORY Then
                If (Count Mod 10) = 0 Then
                    ReDim Preserve D(Count + 10)
                End If
                Count = Count + 1
                D(Count) = DirName
            Else
                AntFichero = Origen & DirName
                NewFichero = Destino & DirName
                FileCopy AntFichero, NewFichero
                If Borrar Then Kill AntFichero
            End If
        End If
        DirName = Dir
    Loop
    For I = 1 To Count
        MkDir Destino & D(I)
        Copiar_Directorio Origen & D(I), Destino & D(I), Borrar
    Next I
End Sub

Esta función no es relevante, pero ayuda… 🙂

Public Function AñadirBarra(Path As String) As String
     ' Agrega una "" al final de Path si no hay una. Esto facilita
     ' más tarde la concatenación de subclaves.
     If Mid(Path, Len(Path), 1)  "" Then
          AñadirBarra = Path & ""
     Else
          AñadirBarra = Path
     End If
End Function
Anuncios

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión /  Cambiar )

Google photo

Estás comentando usando tu cuenta de Google. Cerrar sesión /  Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión /  Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión /  Cambiar )

Conectando a %s