Ver Mensaje Individual
  #4 (permalink)  
Antiguo 04/04/2006, 07:36
Avatar de 3pies
3pies
Colaborador
 
Fecha de Ingreso: diciembre-2003
Ubicación: Desde una destilería
Mensajes: 2.584
Antigüedad: 21 años, 1 mes
Puntos: 144
Cita:
Iniciado por potypoty
1 - Poder leer los nombres de todos los archivos que estén en la carpeta en cuestión y eliminarlos.
Vamos a añadir unas líneas (lo que hay en rojo), a la vista de eso. Ojo, es peligroso jugar con esas líneas que acabo de añadir, a no ser que se tengan las cosas claras.

Código:
Sub listado_ficheros()
Application.ScreenUpdating = False
'Definimos la carpeta en la que meternos
ruta = "C:\Mis documentos"
'Creamos el objeto FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Carpetas = FSO.GetFolder(ruta)
Set ArchivosDelDirectorio = Carpetas.Files
Set Subcarpetas = Carpetas.SubFolders
Range("A1") = "CARPETAS"
Range("A2").Select
For Each Elementos In Subcarpetas
    NombreDeLaSubcarpeta = Elementos.Name
    ActiveCell = NombreDeLaSubcarpeta
    ActiveCell.Offset(1, 0).Activate
Next
Range("B1") = "ARCHIVOS"
Range("B2").Select
For Each Elementos In ArchivosDelDirectorio
    NombreDeLosArchivos = Elementos.Name
    ActiveCell = NombreDeLosArchivos
    ActiveCell.Offset(1, 0).Activate
    '******* EDITADO ********
    'Si tenemos el fichero "pepe.xls", lo borramos
    '(podrías poner un msgbox, si quieres)
    FicheroABorrar = "pepe.xls"
    If FSO.FileExists(ruta & "\" & FicheroABorrar) Then
        'Borramos el fichero (ojo, que es peligroso: vamos a borrarrrrrrr)
        FSO.DeleteFile (ruta & "\" & FicheroABorrar)
    End If
    '************************
Next
Set FSO = Nothing
Set Carpetas = Nothing
Set ArchivosDelDirectorio = Nothing
Set Subcarpetas = Nothing
Application.ScreenUpdating = true
End Sub
Salu2

Editado:
Ayer se me olvidó comentar algo muy importante: los ficheros borrados utilizando este método, no son recuperables, pues no van a la papelera de reciclaje. De ahí que se deba utilizar con cautela.

Última edición por 3pies; 05/04/2006 a las 02:15