Programa que Borra Ficheros Anteriores a x dias
Publicado por josepf (54 intervenciones) el 01/03/2010 14:11:29
Buenas Compañeros!
Se me planteó hacer un programilla que borrase copias se seguridad creadas automáticamente y que venian de sql server, passados unos dias, copias viejas, automáticamente. Os pongo lo que hice, ya que vi en el foro que habia gente que lo buscaba.
1.- Creamos una base de datos que tenga un único formulario y le ponemos:
Private Sub Form_Load()
Dim ruta As String
Dim dias As Integer
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(CurrentProject.Path & "\borrar.txt", 1, 0)
ruta = f.readline
dias = f.readline
f.Close
Dim strArchivo As String
strArchivo = Dir(ruta & "*.*")
While strArchivo <> ""
If FechaCreacionArchivo(ruta & strArchivo) + dias < Date Then
Kill ruta & strArchivo
End If
strArchivo = Dir
Wend
DoCmd.Quit
End Sub
Public Function FechaCreacionArchivo(strArchivo As String) As Date
Dim fso As Object, _
Archivo As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Archivo = fso.GetFile(strArchivo)
FechaCreacionArchivo = Archivo.DateCreated
Set fso = Nothing
Set Archivo = Nothing
End Function ' FechaCreacionArchivo
2.- Se crea un fichero borrar.txt, ubicado en la misma ruta que el .mdb. Donde la primera línea és la ruta, la siguiente los dias a restar de la fecha actual.
D:\Gestion\copias seguridad sql\
7
Espero que os sirva, todo sea para avanzar...
Se me planteó hacer un programilla que borrase copias se seguridad creadas automáticamente y que venian de sql server, passados unos dias, copias viejas, automáticamente. Os pongo lo que hice, ya que vi en el foro que habia gente que lo buscaba.
1.- Creamos una base de datos que tenga un único formulario y le ponemos:
Private Sub Form_Load()
Dim ruta As String
Dim dias As Integer
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile(CurrentProject.Path & "\borrar.txt", 1, 0)
ruta = f.readline
dias = f.readline
f.Close
Dim strArchivo As String
strArchivo = Dir(ruta & "*.*")
While strArchivo <> ""
If FechaCreacionArchivo(ruta & strArchivo) + dias < Date Then
Kill ruta & strArchivo
End If
strArchivo = Dir
Wend
DoCmd.Quit
End Sub
Public Function FechaCreacionArchivo(strArchivo As String) As Date
Dim fso As Object, _
Archivo As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Archivo = fso.GetFile(strArchivo)
FechaCreacionArchivo = Archivo.DateCreated
Set fso = Nothing
Set Archivo = Nothing
End Function ' FechaCreacionArchivo
2.- Se crea un fichero borrar.txt, ubicado en la misma ruta que el .mdb. Donde la primera línea és la ruta, la siguiente los dias a restar de la fecha actual.
D:\Gestion\copias seguridad sql\
7
Espero que os sirva, todo sea para avanzar...
Valora esta pregunta


0