RESPUESTA A LA PREGUNTA 3050 - ACCESS


Aquí te mando el código que utilizo para tener copias de seguridad de los últimos 7 días en formato yyyymmdd.mdb. Este procedimiento puede llamarse desde un formulario de mantenimiento o desde el botón desde el que se cierra la aplicación; no está optimizado ni comentado porque lo hice por una necesidad urgente en su momento y no lo he vuelto a revisar; si hay algo que no tengas claro me lo dices por E-Mail (sin el NOSPAM en la dirección).

Sub CopiaSeguridadDatos()
    Dim ObjetoSistemaArchivos As Object
    Dim Archivo As Object
    Dim CadenaBaseDatos As String
    Dim CadenaCopiaSeguridad As String
    Dim SubCadenaCopia As String
    Dim Cadena As String
    Dim Respuesta As Variant
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Set ObjetoSistemaArchivos = CreateObject("Scripting.FileSystemObject")
    CadenaBaseDatos = Nz(DLookup("[DirectorioDatos]", "Configuraciones", "[PC]='" & NombrePC & "'"), "C:\Archivos de programa\Pere\Programa1")
    CadenaCopiaSeguridad = CadenaBaseDatos
    CadenaBaseDatos = CadenaBaseDatos & "\Datos.mdb"
    SubCadenaCopia = CadenaCopiaSeguridad & "\Copias de seguridad\Datos.mdb"
    Cadena = IIf(Dir$(SubCadenaCopia) = "", "\", "\Copias de seguridad\")
    CadenaCopiaSeguridad = CadenaCopiaSeguridad & Cadena & Format(Year(Date), "0000") & Format(Month(Date), "00") & Format(Day(Date), "00") & ".mdb"
    Set Archivo = ObjetoSistemaArchivos.GetFile(CadenaBaseDatos)
    Cadena = IIf(Dir$(CadenaBaseDatos) = "", "", CadenaBaseDatos)
    If Cadena <> "" Then
        Cadena = IIf(Dir$(CadenaCopiaSeguridad) = "", "", CadenaCopiaSeguridad)
        If Cadena = "" Then
            Archivo.Copy CadenaCopiaSeguridad
        Else
            Respuesta = MsgBox("Ya existe una copia de seguridad del día de hoy. ¿Desea reemplazarla?", vbYesNo, "Copia de seguridad ya realizada...")
            If Respuesta = vbYes Then
                Archivo.Copy CadenaCopiaSeguridad
            End If
        End If
        CadenaBaseDatos = Nz(DLookup("[DirectorioDatos]", "Configuraciones", "[PC]='" & NombrePC & "'"), "C:\Archivos de programa\Pere\Programa1")
        CadenaCopiaSeguridad = CadenaBaseDatos
        Cadena = IIf(Dir$(SubCadenaCopia) = "", "\", "\Copias de seguridad\")
        CadenaCopiaSeguridad = CadenaCopiaSeguridad & Cadena
        If Day(Date) < 10 And Month(Date) = 1 Then
            k = Year(Date) - 1
            j = 12
            For i = 1 To 31
                SubCadenaCopia = CadenaCopiaSeguridad & Format(k, "0000") & Format(j, "00") & Format(i, "00") & ".mdb"
                Cadena = IIf(Dir$(SubCadenaCopia) = "", "", SubCadenaCopia)
                If Cadena <> "" Then
                    Set Archivo = ObjetoSistemaArchivos.GetFile(SubCadenaCopia)
                    Archivo.Delete 'Cadena
                End If
            Next i
        ElseIf Day(Date) < 10 Then
            k = Year(Date)
            j = Month(Date) - 1
            For i = 1 To 31
                SubCadenaCopia = CadenaCopiaSeguridad & Format(k, "0000") & Format(j, "00") & Format(i, "00") & ".mdb"
                Cadena = IIf(Dir$(SubCadenaCopia) = "", "", SubCadenaCopia)
                If Cadena <> "" Then
                    Set Archivo = ObjetoSistemaArchivos.GetFile(SubCadenaCopia)
                    Archivo.Delete 'Cadena
                End If
            Next i
        Else
            k = Year(Date)
            j = Month(Date)
            For i = 1 To (Day(Date) - 7)
                SubCadenaCopia = CadenaCopiaSeguridad & Format(k, "0000") & Format(j, "00") & Format(i, "00") & ".mdb"
                Cadena = IIf(Dir$(SubCadenaCopia) = "", "", SubCadenaCopia)
                If Cadena <> "" Then
                    Set Archivo = ObjetoSistemaArchivos.GetFile(SubCadenaCopia)
                    Archivo.Delete 'Cadena
                End If
            Next i
        End If
        Set Archivo = Nothing
        Set ObjetoSistemaArchivos = Nothing
    Else
        MsgBox "El archivo de datos no se encuentra en la ruta " & CadenaBaseDatos & "..." & vbCr & vbCr & "Introduzca una ruta correcta antes de realizar la copia de seguridad...", vbOKOnly + vbCritical, "Error en la copia de seguridad"
        Set Archivo = Nothing
        Set ObjetoSistemaArchivos = Nothing
    End If
End Sub


Pere Escobar Solsona
psolsonaNOSPAM@geocities.com