Bucle para eliminar ficheros y carpetas

Te envié esta pregunta por email, pero se ve que tengo algún problema y no te deben llegar.

He hecho este código para recorrer, a modo de ensayo, las subcarpetas de la carpeta principal D:\MUSICA\LISTAS\. Luego incluiré las instrucciones Kil o Rmdir según quiera eliminar un fichero o una carpeta, pero no consigo ver los ficheros de las subcarpetas.

Do While Archivo <> "" : Archivo contiene la dirección de la carpeta madre

Kk = Archivo : esto lo hago para ver el valor que va cogiendo

        If Archivo <> "." And Archivo <> ".." Then                                            : Como quiero dejar la carpeta madre, paso de estas

            LisFic = Archivo & "\"                                                                       : Aquí añado la ultima barra para recorrer la carpeta que si ha cogido el nombre

            Fich = Dir(LisFic)

            Do While Fich <> ""

                kkk = Fich

‘              Kill kkk                                                                                Aquí pondré el Kill del fichero

                Fich = Dir

            Loop

        End If

' Rmdir Archivo & kk

Archivo = Dir : aquí es donde se queda, después de decirme “Argumento o llamada a procedimiento no valido”

    Loop

Por favor, ¿me puedes decir que estoy haciendo mal?

2 respuestas

Respuesta
2

Le muestro como puede recorrer con DIR$() los archivos PDF de una carpeta.

Sub temp()
 'Listar todos los archivos de una carpeta con Dir$()
Dim MiArchivo As String
Dim Contador As Long
'Cree una variable de matriz dinámica y luego declare su tamaño inicial
Dim DirectoryListArray() As String
ReDim DirectoryListArray(1000)
'Recorra todos los archivos en el directorio usando la función Dir$
MiArchivo = Dir$("D:\TodoExpertos\AdjuntarArchivo\*.pdf")
Do While MiArchivo <> ""
    DirectoryListArray(Contador) = MiArchivo
    MiArchivo = Dir$
    Contador = Contador + 1
Loop
'Restablezca el tamaño de la matriz sin perder sus valores usando Redim Preserve
ReDim Preserve DirectoryListArray(Contador - 1)
'Para probar que funcionó, podrías ejecutar lo siguiente
For Contador = 0 To UBound(DirectoryListArray)
    'Debug.Print escribe los resultados en la ventana Inmediato (presione Ctrl + G para verlo)'
    Debug.Print DirectoryListArray(Contador)
Next Contador
End Sub

Esto le muestra en la ventana de inmediato algo como:

1149001.PDF
1149002.PDF
1149003.PDF
1149004.PDF
1149005.PDF
alumno_Eduado.PDF
alumno_Inés.PDF
alumno_Iván.PDF
alumno_Jorge.PDF
alumno_Juan.PDF
alumno_Maria.PDF
alumno_Mario.PDF
alumno_Pedro.PDF

Si quiere envíeme su base de datos con datos ficticios a [email protected] y trato de colaborarle.

Ahora si quiere una función más practica le dejo este código

Function RecorrerArchivos(rutaCarpeta As String)
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(rutaCarpeta)
    For Each objFile In objFolder.Files
        ' Aquí puede  hacer lo que necesite  con cada archivo, por ejemplo:
        Debug.Print objFile.Name
    Next objFile
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objFile = Nothing
End Function

La ventaja es que dentro el For Each Next puede hacer lo que quiera con el archivo.

Le dejo una función recursiva más completa, es posible deba hacer referencia a la librería Microsoft Scripting Runtime.

Public Function ArchivosCarpetas(rutaCarpeta As String, Optional archivocarpeta As Byte)
'Función para recorrer archivos y carpetas
'Parámetros:
'              Si no se pasa muestra archivos de la carpeta principal
'               y subcarpetas con archivos
'              1= Muestra solo los archivo de la carpeta principal
'              2= Muestra Solo las carpetas de la carpeta principal
'Elaborado por:
'               EDUARDO PÉREZ FERNÁNDEZ
'Fecha        : 04/02/2023
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objSubFolder As Object
    Dim objFile As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(rutaCarpeta)
    If archivocarpeta = 0 Then
         ' Mostramos los archivos de la carpeta principal
        For Each objFile In objFolder.Files
            Debug.Print objFile.Path
        Next objFile
       ' Recorremos las subcarpetas y mostramos sus archivos
        For Each objSubFolder In objFolder.SubFolders
            ArchivosCarpetas objSubFolder.Path
            For Each objFile In objSubFolder.Files
                Debug.Print objFile.Path
            Next objFile
        Next objSubFolder
    End If
    If archivocarpeta = 1 Then 'Mostrar solo archivos de la carpeta principal
        ' Mostramos los archivos de la carpeta principal
        For Each objFile In objFolder.Files
            Debug.Print objFile.Path
        Next objFile
    End If
   If archivocarpeta = 2 Then
      ' Recorremos las subcarpetas y mostramos sus archivos
        For Each objSubFolder In objFolder.SubFolders
            ArchivosCarpetas objSubFolder.Path
            For Each objFile In objSubFolder.Files
                Debug.Print objFile.Path
            Next objFile
        Next objSubFolder
   End If
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objSubFolder = Nothing
    Set objFile = Nothing
End Function

Observe que la función tiene 2 parámetros, ruta y   nombre de la carpeta, y un segundo parámetro que permite se indique si quiere ver solo archivos de la carpeta o las subcarpetas y archivos. Si no se pasa el parámetro muestra todo.

Ejemplos de llamada en la ventana de inmediato

¿
? ArchivosCarpetas("D:\TodoExpertos") - Muestra todo, archivos carpeta ppal y subcarpetas con archivos
? ArchivosCarpetas("D:\TodoExpertos", 1) - Muestra solo los archivos de la carpeta principal
? ArchivosCarpetas("D:\TodoExpertos", 2) - Muestra solo las carpetas de la carpeta principal

Eduardo, me va fenomenal con la primera llamada. Lo que he hecho ha sido esto :

If archivocarpeta = 0 Then
' Mostramos los archivos de la carpeta principal
For Each objFile In objFolder.Files
xkk1 = objFile
Kill objFile                                                                 ' Borra Ficheros de la CARPETA PRINCIPAL
' Debug.Print objFile.Path
Next objFile
' Recorremos las subcarpetas y mostramos sus archivos
For Each objSubFolder In objFolder.SubFolders
ArchivosCarpetas objSubFolder.Path
For Each objFile In objSubFolder.Files
xkk2 = objFile
Kill objFile                                                            ' Borra los Ficheros de la SUBCARPETA
' Debug.Print objFile.Path
Next objFile
RmDir objSubFolder                                           ' Borra SubCarpeta
Next objSubFolder
End If

¡Muchas Gracias! 

Respuesta
1

Acabo de llegar de viaje, ¿es qué no te gusta la nieve?. A mi no, pero como a mi mujer sí... He mirado el correo y si he visto, tanto el mensaje como este aviso. Me alegro de que la solución que te ofrecen se adapte a tus necesidades.

Bueno, la nieve, si es para disfrutar si me gusta. Espero que en verano te toque elegir a ti....

Si, la solución que me ha dado Eduardo Pérez me viene perfecta.

¡Muchas Gracias! 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas