Compactar base de datos externa

[xavi]

Palabras clave: compactar, base de datos, externa
Autor: No lo sé
Extraído de: No lo sé

Objetivo:
Compactar un base de datos pasada como argumento

Código: [Seleccionar]

Function CompactarOtraBDD(strFullPath As String)
    On Error GoTo ErrorHandler
   
    Dim strNewNombre    As String
    Dim strBackend      As String
   
    ' Función para compactar una base de datos externa
   
    ' Comprobamos si alguien está conectado a la base de datos. Simplemente miramos si existe el laccdb
    If Len(Dir(Replace(strFullPath, ".accdb", ".laccdb"), vbArchive)) > 0 Then
        ' Parece bloqueado
        MsgBox "La base de datos está en uso. Espere a que sea liberada para poder compactarla.", vbExclamation, cStrTitMb
        Exit Function
    End If
   
    strNewNombre = Replace(strFullPath, ".accdb", "_Backup.accdb")
    If Len(Dir(strNewNombre, vbArchive)) > 0 Then
        ' Borramos backup previo
        Kill strNewNombre
    End If
   
    DBEngine.CompactDatabase DamePathCompletoDatos, strNewNombre
    ' Borramos el BackEnd
    Kill strFullPath
   
    ' Renombramos el backup
    Name strNewNombre As strFullPath

ExitProcedure:
    On Error GoTo 0
    Exit Function
ErrorHandler:
    Select Case Err.Number
        Case 0
        Case Else
            MsgBox "Error " & Err.Number & " - " & Err.Description & vbNewLine & _
                    "Procedimiento: CompactarOtraBDD" & vbNewLine & _
                    "Módulo: " & Application.VBE.ActiveCodePane.CodeModule.Name, vbCritical, "AVISO"
            Resume ExitProcedure
    End Select
End Function