Compactando um Banco de dados - DAO e ADO


Sabe qual o problema com uma base de dados Access ?  Ela cresce , cresce , e cresce , não importa se você exclui registros e mais registros da base de dados , ela continua crescendo. A única maneira de fazer o mdb encolher e compactar a base de dados. As vezes o tamanho chega a cair de megas para kbytes...

Nas versões anteriores a versão 3.6 do Jet a DAO usava o método RepairDatabase para reparar uma base de dados e o método CompactDatabase para compactar o banco de dados. O processo era feito em duas etapas. Assim temos abaixo as rotinas para compactar e reparar uma base de dados nas versões anteriores a  versão 3.6 do Jet ( 3.51, etc.).

Reparando um base de dados - Versão anterior a 3.6

Private Sub CmdReparar_Click()
    On Error GoTo Reparar_Error
    Dim MDB_Base As String
    
    CommonDialog1.Filter = "Access (*.mdb)|*.mdb"
    CommonDialog1.Flags = &H1000
    CommonDialog1.FilterIndex = 1
    CommonDialog1.Action = 1
    
    If CommonDialog1.FileName <> "" Then
        Screen.MousePointer = 11
        MDB_Base = CommonDialog1.FileName
        RepairDatabase (MDB_Base)
        Screen.MousePointer = 0
        MsgBox "Base reparada com sucesso! ", vbInformation, "Reparar Base de Dados"
    End If
    Screen.MousePointer = 0
    Exit Sub
    
Reparar_Error:
    MsgBox "Erro durante a reparaççao da base de dados", vbCritical, "Error"
    Screen.MousePointer = 0
    Exit Sub

End Sub

 Compactando uma base de dados - Versão anterior a 3.6

Private Sub cmdcompactar_Click()
On Error GoTo Compact_Error

Dim MDB_Nome As String
Dim MDB_NovoNome As String
Dim MDB_Caminho As String
Dim MDB_Opcoes As String

MDB_NovoNome = "c:\teste.mdb"
CommonDialog1.Filter = "Access (*.MDB)|*.mdb"
CommonDialog1.Flags = &H1000
CommonDialog1.FilterIndex = 1
CommonDialog1.Action = 1

If CommonDialog1.FileName <> "" Then
  MDB_Nome = CommonDialog1.FileName
  CompactDatabase MDB_Nome, MDB_NovoNome & MDB_Caminho & MDB_Opcoes
  Kill MDB_Nome
  Name MDB_NovoNome & MDB_Caminho & MDB_Opcoes As MDB_Nome
  MsgBox "Base de dados compactada com sucesso !", vbInformation, "Compactar Base de dados"
End If
Exit Sub

Compacta_Error:
  MsgBox "Base de dados nao pode ser compactada", vbCritical, "Erro na Compactacao"
  Exit Sub
End Sub

A partir da versão 3.6 do Jet a coisa mudou , ficou mais simples. A função CompactDatabase agora compacta e faz a reparação da base de dados ao mesmo tempo. Vejamos um exemplo onde tomamos o cuidado de checar a versão da DAO 

Compactando e Reparando uma base de dados - Versão 3.6 ou superior

Function CompactarRepararDatabase(DatabasePath As String, _
Optional Password As String, Optional TempFile As String = "c:\temp.mdb")

'se a versão DAO for anterior a 3.6 , então devemos usar o método RepairDatabase
'se a versao DAO for a 3.6 ou superior basta usar a função CompactDatabase
If DBEngine.Version < "3.6" Then DBEngine.RepairDatabase DatabasePath

'se nao informou um arquivo temporario usa "c:\temp.mdb"
If TempFile = "" Then TempFile = "c:\temp.mdb"

'apaga o arquivo temp se existir
If Dir(TempFile) <> "" Then Kill TempFile

'formata a senha no formato ";pwd=PASSWORD" se a mesma existir
If Password <> "" Then Password = ";pwd=" & Password

'compacta a base criando um novo banco de dados
DBEngine.CompactDatabase DatabasePath, TempFile, , , Password

'apaga o primeiro banco de dados
Kill DatabasePath

'move a base compactada para a origem
FileCopy TempFile, DatabasePath

'apaga o arquivo temporario
Kill TempFile

End Function

Compactando e Reparando uma base de dados - Usando ADOX - JRO

A ADO não nos fornece meios para reparar ou compactar um banco de dados Access. Para realizar tal tarefa devemos usar uma extensão da ADO: Microsoft Jet OLE DB Provider and Replication Objects (JRO). Esta capacidade foi implementada a partir da versão 4.0 do PROVEDOR JET OLE DB (Mjsetoledb40.dll) e da versão 2.1 da JRO (Msjro.dll) . Esses arquivos estão disponíveis para instalação na MDAC 2.1. ( Universal Data Access Web Site ).

Vamos ao projeto para compactar uma base de dados usando JRO.

Private Sub Command1_Click()
Dim origem_path, destino_path As String
If Text1.Text <> "" And Text2.Text <> "" Then
   origem_path = Text1.Text
   destino_path = Text2.Text

   If Not compactaDB(origem_path, destino_path) Then
       MsgBox "Ocorreu um erro durante a compactacao " & vbCrLf & vbCrLf & Text2.Text, vbExclamation
   Else
       MsgBox Text1.Text & "foi compactado com sucesso", vbInformation, " Compactando com JRO"
   End If

End If
End Sub

Public Function compactaDB(ByVal origem_path As String, _
ByVal destino_path As String) As Boolean


On Error GoTo Erro_compacta

Dim DB_origem As String, DB_destino As String
Dim JRO As JRO.JetEngine
Set JRO = New JRO.JetEngine

DoEvents
DB_origem = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & origem_path
DB_destino = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & destino_path & " ;Jet OLEDB:Engine Type=5"

JRO.CompactDatabase DB_origem, DB_destino

compactaDB = True
Exit Function

Erro_compacta:
compactaDB = False
MsgBox Err.Description, vbExclamation
End Function

O Engine Type=5 indica que formato dos arquivos é para a versão 4.0 do JET. Para versões anteriores siga a tabela abaixo:

Jet OLEDB:Engine Type Jet x.x Formato dos arquivos MDB
1 JET10
2 JET11
3 JET2X
4 JET3X
5 JET4X

Agora é só clicar e compactar...

Tchau.. ,