Aunque la respuesta que le da Julián es suficiente para lo que usted necesita le presento una herramienta que elaboré para hacer mantenimiento de mis backups, consta de un formulario, una tabla, un módulo. El formulario contiene un cuadro de lista, unos cuadros combinados y algo de código, la ventaja es que no se limita a determinada cantidad de archivos ni al tipo de archivo.
TABLA TBLTEM_ELIMINAR
El campo fecha_creado debe estar en formato definido como Fecha General.
FORMULARIO
Hago cli en el botón "Seleccionar" para elegir la carpeta que contiene los archivos.
Observe que he seleccionado la carpeta que está en la ubicación D:\PuntoVenta\Backups. En esta carpeta tengo unos archivos con extensión backup, son copias de la base de datos PostgreSQL.
Selecciono la extensión backup (en este cuadro combinado hay una serie de extensiones como: mdb, accdb, xls, xlsx, doc, docx, txt, zip, rar, jpg, bmp), aunque están definidas como lista de valores se puede crear una tabla con éstas.
Observe que en el cuadro de lista me muestra seleccionados los 3 archivos de acuerdo con lo elegido en el cuadro combinado "Cantidad a retirar". Hago clic en el botón Eliminar y obtengo el siguiente mensaje:
Hago clic en el botón Si para proceder con el retiro. Si todo fue correcto obtendré un mensaje que así lo indica. Ahora si selecciono 1 archivo a retirar y vuelvo hacer clic en el botón Eliminar, obtengo:
Efectivamente me resalta el más antiguo.
CODIGO DEL BOTÓN SELECCIONAR
Private Sub btnCarpeta_Click()
Me.ctlCarpeta = selectCarpeta()
End Sub
FUNCIÓN SELECTCARPETA()
Esta función la puede crear en un módulo, así le sirve para otros formularios.
Public Function selectCarpeta() As String
'Creamos un control de errores
On Error GoTo sol_err
'Declaramos las variables
Dim vFD As Object 'vFD=FileDialog
Dim vRutaIni As String
'Difinimos la ruta inicial
vRutaIni = Application.CurrentProject.Path
'Creamos el objeto FileDialog
Set vFD = Application.FileDialog(msoFileDialogFolderPicker)
'Configuramos las características de nuestra ventana de dialogo
With vFD
.Title = "Seleccione la carpeta de destino"
.ButtonName = "Aceptar"
.InitialView = msoFileDialogViewList
.InitialFileName = vRutaIni
'Detectamos el boton pulsado por el usuario
If .Show = -1 Then
'Asignamos a la función la carpeta seleccionada, convirtiendola a un valor de tipo String
selectCarpeta = CStr(.SelectedItems.Item(1))
Else
'Si se pulsa cancelar avisamos y salimos
MsgBox "Ha cancelado la selección", vbOKCancel Or vbExclamation Or vbMsgBoxSetForeground, "Archivos"
Exit Function
End If
End With
Salida:
Exit Function
sol_err:
MsgBox "Se ha producido un error: " & Err.Number & " - " & Err.Description
Resume Salida
End Function
CODIGO DEL BOTÓN ELIMINAR
Private Sub btnEliminar_Click()
On Error GoTo hay_error
Dim flag As Boolean
Dim ruta As String
Dim Fichero As String
Dim MiPc, Carpeta, Archivos, archivo, ultimoModificado As Date
Dim strFecha As String
Dim strSQL As String
Dim intNumAct As Integer
Dim varPosicion As Variant
flag = False
Me.lstArchivos.Visible = False
If IsNull(Me.ctlCarpeta) Or Me.ctlCarpeta = "" Then
MsgBox "Falta el nombre de la carpeta", vbInformation, "Error.."
Me.ctlCarpeta.SetFocus
Exit Sub
End If
If IsNull(Me.cboExtension) Or Me.cboExtension = "" Then
MsgBox "Falta el nombre de la extensión", vbInformation, "Error,,"
Me.cboExtension.SetFocus
Exit Sub
End If
If IsNull(Me.cboCantidad) Or Me.cboCantidad = "" Then
MsgBox "Falta la cantidad de archivos a seleccionar", vbCritical, "Error.."
Me.cboCantidad.SetFocus
Exit Sub
End If
ruta = Me.ctlCarpeta
CurrentDb.Execute "DELETE FROM tbltem_eliminar"
Me.lstArchivos = ""
Set MiPc = CreateObject("Scripting.FileSystemObject")
Set Carpeta = MiPc.GetFolder(ruta)
Set Archivos = Carpeta.Files
For Each archivo In Archivos
If InStrRev(archivo.Name, ".") > 0 Then
If Mid(archivo.Name, InStrRev(archivo.Name, ".")) = "." & Trim(Me.cboExtension) Then
strFecha = "INSERT INTO tbltem_eliminar(archivo,fecha_creado) VALUES('" & archivo.Name & "',"
strFecha = strFecha & "#" & Format(archivo.DateCreated, "mm/dd/yyyy hh:mm:ss") & "#" & ")"
CurrentDb.Execute strFecha
End If
End If
Next
Set MiPc = Nothing
Set Carpeta = Nothing
strSQL = ""
strSQL = "SELECT archivo, fecha_creado" & vbCrLf
strSQL = strSQL & " From tbltem_eliminar ORDER BY fecha_creado ASC;"
Me.lstArchivos.RowSource = strSQL
For intNumAct = 0 To Me.lstArchivos.ListCount - 1
Me.lstArchivos.Selected(intNumAct) = True
If intNumAct = Me.cboCantidad - 1 Then
Exit For
End If
Next intNumAct
'Retiro los archivos resaltados
If Me.lstArchivos.ListCount = 0 Then
MsgBox "En la carpeta " & Me.ctlCarpeta & " no hay archivos con la extensión " & UCase(Me.cboExtension), vbInformation, "RETIRANDO ARCHIVOS"
Exit Sub
End If
Me.lstArchivos.Visible = True
If MsgBox("¿Está seguro que retira de la carpeta " & Me.ctlCarpeta & " los " & Me.cboCantidad & " archivos con la extensión " _
& Me.cboExtension & "?", vbYesNo + vbDefaultButton2 + vbQuestion, "RETIRANDO ARCHIVOS") = vbYes Then
For Each varPosicion In lstArchivos.ItemsSelected
Kill Me.ctlCarpeta & "\" & Me.lstArchivos.ItemData(varPosicion)
If Err.Number = 0 Then
flag = True
End If
Next varPosicion
Else
Me.lstArchivos.Visible = False
End If
If flag Then
MsgBox "Archivos retirados satisfactoriamente", vbInformation, "RETIRANDO ARCHIVOS"
End If
hay_error_exit:
Exit Sub
hay_error:
MsgBox "Ocurrió el error " & Err.Description & " " & Err.Description, vbCritical, "ERROR ...."
Resume hay_error_exit
End Sub
Se pueden hacer muchas mejoras, por ejemplo utilizar TOP en la consulta SQL etc. Si está interesado en esta herramienta puede solicitarla a [email protected], favor anotar en el asunto la consulta.