Bienvenido a la mayor comunidad de usuarios EXCEL

Regístrate ahora y podrás: / 💪 Hacer preguntas a los expertos / ⬇️ Descargar ejemplos y plantillas / 🏅 Acceder a contenidos premium

Regístrate gratis

Macro para borrar archivos excel de mas de 5 días

hac

Member
Hola buen día, desde hace años utilizo para controlar la producción en la empresa donde trabajo unos archivos de Excel que con la ayuda de unos cuantos macros me ayudan a cargar ordenes, darles de baja, etc,etc.
Cada vez que ejecuto el macro que me saca de la misma, mientras va cerrando libros va haciendo copia de seguridad en otro directorio diferente al que utilizo para las base de uso diario, son 5 hojas de calculo que hace copia, con el siguiente formato (NOMBREARCHIVO.XLS2021_1102_10.55.22). Esto significa que si abro y cierro 5 veces el programa diario se generan 25 archivos de copia de seguridad.
Lo que necesito si es posible, agregar al final del macro que cierra y sale, un codigo que borre todos los archivos de la copia de seguridad que tengan mas de 5 dias.
desde ya muchas gracias.
 

silver_axe007

Active member
Espero esto te ayude
Tomado en base de la url : ExceltotalMacroListarArchivos
Modificado Por mi,


este seria el código y al terminar tu respaldo lo que haces es llamar al procedimiento enviando la ruta donde están los archivos y el numero de días que te considere, por que le puse variable el numero de días ,porque los lunes también elimino los que tengan 5 días menos aun sin tener sabado y domingo?

-Prueba primero con archivos y una carpeta de pruebas no me responsabilizo por perdida de archivos.,
Código:
Sub Eliminar_Archivos(ruta as string, Dias as Integer)
 
    'Sección 1: Declaración de variables y objetos
    Dim fs, carpeta, archivo, subcarpeta As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
     
    'Sección 2: Ajustes necesarios a ruta
    If ruta = "" Then
        Exit Sub
    ElseIf Right(ruta, 1) <> "" Then
        ruta = ruta & ""
    End If
     
    'Sección 3: Objeto Folder de la ruta indicada
    On Error GoTo ErrHandler
    Set carpeta = fs.GetFolder(ruta)
     
    'Sección 4: Obtener archivos del objeto Folder
    For Each archivo In carpeta.Files
        if  date - archivo.datecreated > dias then kill archivo
    Next
    Exit Sub
     
ErrHandler:
    msgbox "Ruta inexistente"
 
End Sub
 

hac

Member
Muchas gracias por tu respuesta, pero algo debo estar haciendo mal, al finalizar mi macro de salida intercale el código que me enviaste pero no funciona corre todo el código y al final me pone archivo inexistente en el msbox, pero no borra nada, luego intente crear una macro con eliminar_archivos para luego llamarla con call, pero, esta luego no aparece en la lista de macros, creo que me estoy equivocando
 
Última edición:

silver_axe007

Active member
Muchas gracias por tu respuesta, pero algo debo estar haciendo mal, al finalizar mi macro de salida intercale el código que me enviaste pero no funciona corre todo el código y al final me pone archivo inexistente en el msbox, pero no borra nada, luego intente crear una macro con eliminar_archivos para luego llamarla con call, pero, esta luego no aparece en la lista de macros, creo que me estoy equivocando
ese error te da si la ruta en la que mandas a borrar no existe estas invocando bien el procedimiento y enviando la ruta de los archivos y el numero de dias a borrar?

Eliminar_Archivos "c:\temp\" , 5
 

hac

Member
'Sección 1: Declaración de variables y objetos
Dim fs, carpeta, archivo, subcarpeta As Object
Set fs = CreateObject("Scripting.FileSystemObject")

'Sección 2: Ajustes necesarios a ruta
If ruta = "C:\mis documentos H\produccion\back produccion\logos\" Then
Exit Sub
ElseIf Right(ruta, 1) <> "" Then
ruta = ruta & ""
End If

'Sección 3: Objeto Folder de la ruta indicada
On Error GoTo ErrHandler
Set carpeta = fs.getfolder(ruta)

'Sección 4: Obtener archivos del objeto Folder
For Each archivo In carpeta.Files
If Date - archivo.datecreated > 5 Then Kill archivo
Next
Exit Sub

ErrHandler:
MsgBox "Ruta inexistente"

Asi lo modifique, pero algo esta mal
 

silver_axe007

Active member
'Sección 1: Declaración de variables y objetos
Dim fs, carpeta, archivo, subcarpeta As Object
Set fs = CreateObject("Scripting.FileSystemObject")

'Sección 2: Ajustes necesarios a ruta
If ruta = "" Then
Exit Sub
ElseIf Right(ruta, 1) <> "" Then
ruta = ruta & ""
End If

'Sección 3: Objeto Folder de la ruta indicada
On Error GoTo ErrHandler
Set carpeta = fs.getfolder(ruta)

'Sección 4: Obtener archivos del objeto Folder
For Each archivo In carpeta.Files
If Date - archivo.datecreated > 5 Then Kill archivo
Next
Exit Sub

ErrHandler:
MsgBox "Ruta inexistente"
 

pedro4550

New member
Hola buen día, desde hace años utilizo para controlar la producción en la empresa donde trabajo unos archivos de Excel que con la ayuda de unos cuantos macros me ayudan a cargar ordenes, darles de baja, etc,etc.
Cada vez que ejecuto el macro que me saca de la misma, mientras va cerrando libros va haciendo copia de seguridad en otro directorio diferente al que utilizo para las base de uso diario, son 5 hojas de calculo que hace copia, con el siguiente formato (NOMBREARCHIVO.XLS2021_1102_10.55.22). Esto significa que si abro y cierro 5 veces el programa diario se generan 25 archivos de copia de seguridad.
Lo que necesito si es posible, agregar al final del macro que cierra y sale, un codigo que borre todos los archivos de la copia de seguridad que tengan mas de 5 dias.
desde ya muchas gracias.
yo en una macro que requiero hacerle respaldos periódicos, resolví de la siguiente manera:
- cada vez que cierra, crea una copia y se guarda la ruta absoluta en una celda oculta con el nombre de la macro + fecha y hora de guardado.
- en el respaldo numero 10, se borra la copia mas antigua.
- a partir de allí se va creando un sensado cíclico en donde se van renovando los respaldos del mas antiguo al mas reciente, borrándose el archivo de creación (por la fecha en el nombre del archivo que se guardó) mas antiguo.

pero la idea presentada aquí sobre averiguar por los atributos del archivo, la veo mas elegante.
 

hac

Member
Hola como estan, les voy a pegar el código completo que utilizo para salir del excel, realizando las copias de seguridad y en color rojo el código agregado para borrar los archivos de mas de 5 dias, ya que no logro que funcione.

Sub salir()

'PANTALLA COMPLETA
Application.DisplayFullScreen = True
Application.CommandBars("Formatting").Visible = False
Application.CommandBars("Standard").Visible = False

' Ingresa primer vez en pantalla de Salida
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Workbooks.Open "C:\mis documentos H\produccion\seguimiento produccion\salida.xls"
Workbooks("salida.xls").Activate

With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
Range("E8").Value = " "
Range("F9").Value = " "
Range("E8").Value = "Guardando ......"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
ActiveWorkbook.Save
Application.ScreenUpdating = False



' Necesidad de MP rec y virgen
Workbooks.Open "C:\mis documentos H\produccion\seguimiento produccion\programa\MP.xls"
Workbooks("MP.xls").Activate
Dim nombrelibro8 As String
' PRUEBA BORRADO ARCHIVOS DE MAS DE 8 DIAS - nombre corto archivo
'nombrelibro8 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
nombrelibro8 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yy_ddmm_hh,mm") & ".xls"
' FIN PRUEBA BORRADO ARCHIVOS DE MAS DE 8 DIAS - nombre corto archivo
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\" & nombrelibro8
ActiveWorkbook.Save
ActiveWorkbook.Close

' Piezas a producir programadas
Application.ScreenUpdating = False
Workbooks.Open "C:\mis documentos H\produccion\seguimiento produccion\piezas.xls"
Workbooks("piezas.xls").Activate
Dim nombrelibro16 As String
nombrelibro16 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\" & nombrelibro16
ActiveWorkbook.Save
ActiveWorkbook.Close

' Informe diario
Application.ScreenUpdating = False
Workbooks.Open "C:\mis documentos H\produccion\seguimiento produccion\informe diario\año 2015\2015.xls"
Workbooks("2015.xls").Activate
nombrelibro9 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\estadist\" & nombrelibro9
ActiveWorkbook.Save
ActiveWorkbook.Close

' Logos
Workbooks.Open "C:\mis documentos H\produccion\logos.xls"
Workbooks("logos.xls").Activate
Dim nombrelibro2 As String
nombrelibro2 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\" & nombrelibro2
ActiveWorkbook.Save
ActiveWorkbook.Close

' Ingresa segunda vez pantalla de Salida
Workbooks.Open "C:\mis documentos H\produccion\seguimiento produccion\salida.xls"
Workbooks("salida.xls").Activate
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
Range("C11").Value = " Espere por favor - Procesando Archivos - Esta operación demorará unos segundos"
Range("E8").Value = "Guardando ................"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
ActiveWorkbook.Save
Application.ScreenUpdating = False

' Parte diario de Producción
' CAMBIAR NOMBRE DE MES AL INICIO MES
Application.ScreenUpdating = False
Workbooks.Open "C:\Mis Documentos H\PRODUCCION\Seguimiento Produccion\Informe diario\AÑO 2015\03 marzo.xls"
Dim nombrelibro20 As String
nombrelibro20 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\parte diario\parte\" & nombrelibro20
ActiveWorkbook.Save
ActiveWorkbook.Close

' Ingresa tercera vez pantalla de Salida
Workbooks.Open "C:\mis documentos H\produccion\seguimiento produccion\salida.xls"
Workbooks("salida.xls").Activate
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
Range("E8").Value = "Guardando ....................."
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
ActiveWorkbook.Save
Application.ScreenUpdating = False

' Ordenes de Producción Cumplidas historico 01
Workbooks.Open "C:\Mis Documentos H\PRODUCCION\seguimiento Produccion\programa\ord_cumplidas historico01.xls"
Dim nombrelibro30 As String
nombrelibro30 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\" & nombrelibro30
ActiveWorkbook.Save
ActiveWorkbook.Close

' Ingresa cuarta vez pantalla de Salida
Workbooks.Open "C:\mis documentos H\produccion\seguimiento produccion\salida.xls"
Workbooks("salida.xls").Activate
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
Range("E8").Value = "Comenzando back up y cierre..................."
Range("F9").Value = "Realizando copias de Seguridad"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
ActiveWorkbook.Save
Application.ScreenUpdating = False

' Ordenes cumplidas
Workbooks.Open "C:\Mis Documentos H\PRODUCCION\Seguimiento Produccion\Programa\Ordenes_cumplidas.xls"
Dim nombrelibro3 As String
nombrelibro3 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\" & nombrelibro3
ActiveWorkbook.Save
ActiveWorkbook.Close

' Ingresa quinta vez pantalla de Salida
Workbooks.Open "C:\mis documentos H\produccion\seguimiento produccion\salida.xls"
Workbooks("salida.xls").Activate
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False
Range("D8").Value = " "
Range("F9").Value = " "
Range("F9").Value = "Borrando Archivos de más de 5 días - Cerrando Programa"
Range("C11").Value = " "
' Range("F8").Value = " "
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
ActiveWorkbook.Save
Application.ScreenUpdating = False

' Base de datos
Workbooks("base.xls").Activate
Dim nombrelibro5 As String
nombrelibro5 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\base\" & nombrelibro5
ActiveWorkbook.Save

' Programa de Producción
Workbooks("Prog.Moldeo.xls").Activate
Dim nombrelibro6 As String
nombrelibro6 = Left(ActiveWorkbook.Name, 190) & Format(Now, "yyyy_ddmm_hh,mm,ss") & ".xls"
ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\programa\" & nombrelibro6
ActiveWorkbook.Save
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Sheets("programa moldeo").Activate
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

ActiveWorkbook.SaveCopyAs "C:\mis documentos H\produccion\back produccion\" & ThisWorkbook.Name


'Borrar archivos externos de mas de 5 dias

'Sección 1: Declaración de variables y objetos
'Sub Eliminar_Archivos(ruta As String, Dias As Integer)

Dim fs, carpeta, archivo, subcarpeta As Object
Set fs = CreateObject("Scripting.FileSystemObject")

'Sección 2: Ajustes necesarios a ruta
If RUTA = "C:\mis documentos H\produccion\back produccion\" Then
Exit Sub
ElseIf Right(RUTA, 1) <> "C:\mis documentos H\produccion\back produccion\" Then
RUTA = RUTA & "C:\mis documentos H\produccion\back produccion\"
End If

'Sección 3: Objeto Folder de la ruta indicada
On Error GoTo ErrHandler
Set carpeta = fs.getfolder(RUTA)

'Sección 4: Obtener archivos del objeto Folder
For Each archivo In carpeta.Files
If Date - archivo.datecreated > 5 Then Kill archivo
Next
Exit Sub

ErrHandler:
MsgBox "No se encontraron archivos de más de 5 días !!!!"


'vuelta a pantalla normal y salida Excel

Application.DisplayFullScreen = False
Application.CommandBars("Formatting").Visible = True
Application.CommandBars("Standard").Visible = True
ActiveWindow.DisplayHeadings = True
With ActiveWindow
.DisplayGridlines = True
.DisplayHeadings = True

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End With
ActiveWorkbook.Save
Application.Quit

End Sub

espero puedan ayudarme con lo que seguramente estoy haciendo mal, el código anterior funciona muy bien
 

silver_axe007

Active member


reemplaza tu código por este


'Borrar archivos externos de mas de 5 dias

'Sección 1: Declaración de variables y objetos
'Sub Eliminar_Archivos()

dim ruta As String
dim Dias As Integer
Dim fs, carpeta, archivo, subcarpeta As Object
Set fs = CreateObject("Scripting.FileSystemObject")

Ruta = "C:\Carpeta de donde se debe borrar los archivos que tienen mas de 5 dias" ' <-- aqui escribes la ruta
Dias = 5 '<-- aqui pones el numero de dias de los cuales debes borrar los archivoso que tienen creados.

'Sección 2: Ajustes necesarios a ruta
If RUTA = "" Then '<-- aqui es solo para verficar que no haya problema con la ruta aqui no cambias la ruta
Exit Sub
ElseIf Right(RUTA, 1) <> "\" Then ' <-- esto es para ver si tiene la \ al final , no cambies la ruta.
RUTA = RUTA & "\"
End If

'Sección 3: Objeto Folder de la ruta indicada
On Error GoTo ErrHandler
Set carpeta = fs.getfolder(RUTA)

'Sección 4: Obtener archivos del objeto Folder
For Each archivo In carpeta.Files
If Date - archivo.datecreated > dias Then Kill archivo
Next
Exit Sub

ErrHandler:
MsgBox "No se encontraron archivos de más de 5 días !!!!"



Lo he probado y si me funciona perfecto

1614261416459.png
 

hac

Member
Hola como estas, lamentablemente no logro que funcione, no solo no borra los archivos sino que cuando termina de correr el código agregado para borrar, vuelve a la pantalla del programa y no cierra como lo hace cuando no esta el agregado nuevo
 

Temas similares

Arriba