COMPACTAR E REPARAR DB ACCESS 2007
Tenha a função par compactar access 2000, funciona normalmente, mas para access 2007, nao caompacta.
Private Sub cmdCompacta_Click()
On Error GoTo trata_erro
CloseCliente
CloseConexao
cmdCompacta.Enabled = False
Dim origem_path As String, destino_path As String
If txtOrigem.Text <> [Ô][Ô] And txtDestino.Text <> [Ô][Ô] Then
origem_path = txtOrigem.Text
destino_path = txtDestino.Text
If Not compactaDB(origem_path, destino_path) Then
[ô] MsgBox [Ô]Ocorreu um erro durante a compactação [Ô] & vbCrLf & vbCrLf & txtDestino.Text, vbExclamation
Else
Set FSys = CreateObject([Ô]scripting.FileSystemObject[Ô])
FSys.CopyFile App.Path & [Ô]\Teste1.mdb[Ô], App.Path & [Ô]\Teste.mdb[Ô]
Kill (App.Path & [Ô]\Teste1.mdb[Ô])
End If
End If
Exit Sub
trata_erro:
MsgBox [Ô]Error [Ô] & Err.Number & [Ô]: [Ô] & Err.Description, 16, [Ô]Descrição do Erro[Ô]
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 & [Ô];Jet OLEDB:database Password=[Ô] & [Ô]123[Ô]
DB_destino = [Ô]Provider=Microsoft.jet.OLEDB.4.0;Data Source=[Ô] & destino_path & [Ô] ;Jet OLEDB:Engine type=5[Ô] & [Ô];Jet OLEDB:database Password=[Ô] & [Ô]123[Ô]
JRO.CompactDatabase DB_origem, DB_destino
compactaDB = True
Exit Function
Erro_compacta:
compactaDB = False
If Err.Number = [Ô]-2147217897[Ô] Then
Kill (App.Path & [Ô]\Teste1.mdb[Ô])
Else
MsgBox [Ô]Error [Ô] & Err.Number & [Ô]: [Ô] & Err.Description, 16, [Ô]Descrição do Erro[Ô]
End If
End Function
Private Sub Form_Load()
On Error GoTo trata_erro
txtOrigem.Text = App.Path & [Ô]\Teste.mdb[Ô]
txtDestino.Text = App.Path & [Ô]\Teste1.mdb[Ô]
frmCompacta.Width = 5535
frmCompacta.Top = 3045
Exit Sub
trata_erro:
MsgBox [Ô]Error [Ô] & Err.Number & [Ô]: [Ô] & Err.Description, 16, [Ô]Descrição do Erro[Ô]
End Sub
O que tenho que mudar para access 2007?
Grato
Private Sub cmdCompacta_Click()
On Error GoTo trata_erro
CloseCliente
CloseConexao
cmdCompacta.Enabled = False
Dim origem_path As String, destino_path As String
If txtOrigem.Text <> [Ô][Ô] And txtDestino.Text <> [Ô][Ô] Then
origem_path = txtOrigem.Text
destino_path = txtDestino.Text
If Not compactaDB(origem_path, destino_path) Then
[ô] MsgBox [Ô]Ocorreu um erro durante a compactação [Ô] & vbCrLf & vbCrLf & txtDestino.Text, vbExclamation
Else
Set FSys = CreateObject([Ô]scripting.FileSystemObject[Ô])
FSys.CopyFile App.Path & [Ô]\Teste1.mdb[Ô], App.Path & [Ô]\Teste.mdb[Ô]
Kill (App.Path & [Ô]\Teste1.mdb[Ô])
End If
End If
Exit Sub
trata_erro:
MsgBox [Ô]Error [Ô] & Err.Number & [Ô]: [Ô] & Err.Description, 16, [Ô]Descrição do Erro[Ô]
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 & [Ô];Jet OLEDB:database Password=[Ô] & [Ô]123[Ô]
DB_destino = [Ô]Provider=Microsoft.jet.OLEDB.4.0;Data Source=[Ô] & destino_path & [Ô] ;Jet OLEDB:Engine type=5[Ô] & [Ô];Jet OLEDB:database Password=[Ô] & [Ô]123[Ô]
JRO.CompactDatabase DB_origem, DB_destino
compactaDB = True
Exit Function
Erro_compacta:
compactaDB = False
If Err.Number = [Ô]-2147217897[Ô] Then
Kill (App.Path & [Ô]\Teste1.mdb[Ô])
Else
MsgBox [Ô]Error [Ô] & Err.Number & [Ô]: [Ô] & Err.Description, 16, [Ô]Descrição do Erro[Ô]
End If
End Function
Private Sub Form_Load()
On Error GoTo trata_erro
txtOrigem.Text = App.Path & [Ô]\Teste.mdb[Ô]
txtDestino.Text = App.Path & [Ô]\Teste1.mdb[Ô]
frmCompacta.Width = 5535
frmCompacta.Top = 3045
Exit Sub
trata_erro:
MsgBox [Ô]Error [Ô] & Err.Number & [Ô]: [Ô] & Err.Description, 16, [Ô]Descrição do Erro[Ô]
End Sub
O que tenho que mudar para access 2007?
Grato
Usando ADO eu usava esta rotina e compactava:
Bdados.Close
DBEngine.CompactDatabase App.Path & [Ô]\Biblio.mdb[Ô], App.Path & [Ô]\bibliobk.mdb[Ô] [ô]compacta banco de dados e renomeia
Kill App.Path & ([Ô]\Biblio.mdb[Ô]) [ô]apaga o BD antigo
Name App.Path & [Ô]\Bibliobk.mdb[Ô] As App.Path & [Ô]\Biblio.mdb[Ô] [ô]renomeia o Banco de Dados
Set Bdados = OpenDatabase(App.Path & [Ô]\[Ô] & [Ô]Biblio.mdb[Ô])
Bdados.Close
DBEngine.CompactDatabase App.Path & [Ô]\Biblio.mdb[Ô], App.Path & [Ô]\bibliobk.mdb[Ô] [ô]compacta banco de dados e renomeia
Kill App.Path & ([Ô]\Biblio.mdb[Ô]) [ô]apaga o BD antigo
Name App.Path & [Ô]\Bibliobk.mdb[Ô] As App.Path & [Ô]\Biblio.mdb[Ô] [ô]renomeia o Banco de Dados
Set Bdados = OpenDatabase(App.Path & [Ô]\[Ô] & [Ô]Biblio.mdb[Ô])
Tópico encerrado , respostas não são mais permitidas