Referenciar Microsoft Jet and Replication Objects 2.6 Library
Private Sub Mnu_Compactar_Click()
On Error GoTo Erro
Dim Antigo, Atual As String
Dim DB_Origem, DB_Destino As String
Dim JRO As JRO.JetEngine
Set JRO = New JRO.JetEngine
Screen.MousePointer = vbHourglass
If DB_VENDAS.State = adStateOpen Then
DB_VENDAS.Close
End If
DB_Origem = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:TESTEVENDAS.MDB;Jet OLEDB:Database Password=SenhaDoMdb;"
DB_Destino = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:TESTEVENDAS1.MDB" & ";Jet.OLEDB:Engine Type=5"
JRO.CompactDatabase DB_Origem, DB_Destino
If Dir("C:TESTEVENDAS.MDB", False) <> "" Then
Kill ("C:TESTEVENDAS.MDB")
Antigo = ("C:TESTEVENDAS1.MDB")
Atual = ("C:TESTEVENDAS.MDB")
Else
Kill ("C:TESTEVENDAS.MDB")
Antigo = ("C:TESTEVENDAS1.MDB")
Atual = ("C:TESTEVENDAS.MDB")
End If
Name Antigo As Atual
Screen.MousePointer = vbDefault
MsgBox "O banco de dados foi desfragmentado com sucesso !", 64, "Atenção"
Exit Sub
Erro:
Screen.MousePointer = 0
MsgBox Err.Description
Err.Clear
Exit Sub
End Sub
Jayme
