compactar y reparar
Necesito compactar y reparar una base de datos en access desde visual basic. Como le hago?
checa esta rutina ok...
'COMPACTAR LA BASE DE DATOS
Private Sub cmdiniciar_Click()
Dim fuente As String
Dim destino As String
fuente = rutaserver & "bd_elementos.mdb"
destino = rutaserver & "old_bd_elementos.mdb"
If Len(txtdbpwd) < 1 Then
MsgBox ("Password no se permite en blanco"), 64, Utilerias.Caption
Exit Sub
End If
Dim jro As jro.JetEngine
Set jro = New jro.JetEngine
On Error GoTo TERMINA
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & fuente & ";Jet OLEDB:Database Password=" & txtdbpwd, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & destino & ";Jet OLEDB:Database Password=" & txtdbpwd
Kill fuente
FileCopy destino, fuente
Kill destino
MousePointer = 0 'Quita el Reloj de arena
MsgBox ("Proceso de Compactación Correcta "), 64, Utilerias.Caption
Set jro = Nothing
Exit Sub
TERMINA:
If Err.Number = -2147217843 Then 'wrong password
MsgBox ("Error en Password "), 64, Utilerias.Caption
Resume
Else
msg = "Ha ocurrido el error ( " & Err.Number & " ) no previsto "
msg = msg & vbCrLf & Err.Description
MsgBox msg, vbCritical, Utilerias.Caption
Exit Sub
End If
End Sub
'COMPACTAR LA BASE DE DATOS
Private Sub cmdiniciar_Click()
Dim fuente As String
Dim destino As String
fuente = rutaserver & "bd_elementos.mdb"
destino = rutaserver & "old_bd_elementos.mdb"
If Len(txtdbpwd) < 1 Then
MsgBox ("Password no se permite en blanco"), 64, Utilerias.Caption
Exit Sub
End If
Dim jro As jro.JetEngine
Set jro = New jro.JetEngine
On Error GoTo TERMINA
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & fuente & ";Jet OLEDB:Database Password=" & txtdbpwd, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & destino & ";Jet OLEDB:Database Password=" & txtdbpwd
Kill fuente
FileCopy destino, fuente
Kill destino
MousePointer = 0 'Quita el Reloj de arena
MsgBox ("Proceso de Compactación Correcta "), 64, Utilerias.Caption
Set jro = Nothing
Exit Sub
TERMINA:
If Err.Number = -2147217843 Then 'wrong password
MsgBox ("Error en Password "), 64, Utilerias.Caption
Resume
Else
msg = "Ha ocurrido el error ( " & Err.Number & " ) no previsto "
msg = msg & vbCrLf & Err.Description
MsgBox msg, vbCritical, Utilerias.Caption
Exit Sub
End If
End Sub
