esto me funciona perfecto
suerte
' Compactar una base de datos con ADO
Dim sDBTmp As String
Dim arc1 As String, arc2 As String
Dim je As JRO.JetEngine
'
On Error GoTo ErrCompactar
'
Cn.Close
Set je = New JRO.JetEngine
'
' Crear un nombre "medio" aleatorio
sDBTmp = "DBT_" & Format$(Minute(Now), "00") & Format$(Second(Now), "00") & ".mdb"
' Asegurarnos de que no existe una base con el nombre temporal
If Len(Dir$(sDBTmp)) Then
Kill sDBTmp
End If
'
' Compactar la base de datos
' je.CompactDatabase "Data Source=" & App.Path & "\datos.dll;" & _
' "Jet OLEDB:Database Password=''", _
' "Data Source=" & App.Path & "\" & sDBTmp & ";Jet OLEDB:Database Password=''"
je.CompactDatabase "Data Source=" & App.Path & "\base.mdb;" & _
"Jet OLEDB:Database Password='pass viejo'", _
"Data Source=" & App.Path & "\" & sDBTmp & ";" & _
"Jet OLEDB:Database Password='pass nuevo'"
' Eliminar la base de datos original
Kill App.Path & "\base.mdb"
'Renombrar la base temporal con el original
arc1 = App.Path & "\" & sDBTmp
arc2 = App.Path & "\base.mdb"
FileCopy arc1, arc2
'Borrar la base temporal
Kill App.Path & "\" & sDBTmp
Exit Sub
ErrCompactar:
' Mostrar el mensaje de error
MsgBox "Error al compactar la base de datos:" & vbCrLf & _
Err.Number & " " & Err.Description, _
vbExclamation, "Error al compactar la base de datos"
Err.Clear