COMPACTACAO DE BANCO ACCESS
Alguém pode me ajudar? Preciso fazer uma compactação do banco Access via código.
Achei o código abaixo, mas dá um erro estranho...
Alguém sabe como fazer isso.
Abaixo o código utilizado:
On Error GoTo Reparar_Error
Dim MDB_Base As String
Fecha_Banco_ADO Db
StatusBar.SimpleText = "Compactando Banco de Dados"
MDB_Base = Caminho_Aplic & Nome_Bco1
RepairDatabase (MDB_Base)
Screen.MousePointer = 0
MsgBox "Base Compactada com sucesso! ", vbInformation, "Manutenção de Banco de Dados"
StatusBar.Refresh
Exit Sub
Abre_Banco_ADO Db
Reparar_Error:
MsgBox "Não foi possÃvel compactar o Banco de Dados. Verifique se algum usuário ficou bloqueado no sistema ou se a base de dados foi corrompida!", vbCritical, "Error"
Screen.MousePointer = 0
Exit Sub
Achei o código abaixo, mas dá um erro estranho...
Alguém sabe como fazer isso.
Abaixo o código utilizado:
On Error GoTo Reparar_Error
Dim MDB_Base As String
Fecha_Banco_ADO Db
StatusBar.SimpleText = "Compactando Banco de Dados"
MDB_Base = Caminho_Aplic & Nome_Bco1
RepairDatabase (MDB_Base)
Screen.MousePointer = 0
MsgBox "Base Compactada com sucesso! ", vbInformation, "Manutenção de Banco de Dados"
StatusBar.Refresh
Exit Sub
Abre_Banco_ADO Db
Reparar_Error:
MsgBox "Não foi possÃvel compactar o Banco de Dados. Verifique se algum usuário ficou bloqueado no sistema ou se a base de dados foi corrompida!", vbCritical, "Error"
Screen.MousePointer = 0
Exit Sub
Eis um verdadeiro exemplo de administração de MDBs(tem funcionado sempre sem problemas):
‘Para access2000 referenciar DAO 3.6
Public Function compactar()
Dim nomeant As String, nomeact As String
Dim SourceFile, DestinationFile
MsgBox "Certifique-se de que todos os utilizadores estão com as bases de Dados Encerradas."
If MsgBox("Compactar as bases de Dados?", _
vbYesNo) = vbYes Then
Kill "\...
ome da mdbant.mdb"
'Compactar base de dados NOME DA MDB
'DBEngine.CompactDatabase "base_normal", "base_compactada", dbLangGeneral, dbVersion30, ";pwd=senha"
DBEngine.CompactDatabase "\...
ome da mdb.mdb", "\...
ome da mdbtemp.mdb", dbLangGeneral & ";pwd=pass", dbEncrypt, ";pwd=pass"
SourceFile = "\...
ome da mdb.mdb" ' Define o nome do ficheiro de origem.
DestinationFile = "\...
ome da mdbant.mdb" ' Define o nome do ficheiro de destino.
FileCopy SourceFile, DestinationFile ' Copia o ficheiro de origem para o de destino.
Kill "\...
ome da mdb.mdb"
nomeant = "\...
ome da mdbtemp.mdb"
nomeact = "\...
ome da mdb.mdb"
Name nomeant As nomeact
MsgBox "Base de dados compactada com sucesso!"
End If
End Function
Public Function reparar()
Dim errLoop As Error
MsgBox "ATENÇÃO.Certifique-se de que todos os utilizadores estão com as bases de Dados Encerradas."
If MsgBox("Reparar a base de Dados nome da mdb.MDB?", _
vbYesNo) = vbYes Then
Kill "c:\seg
ome da mdb.mdb"
On Error GoTo Err_Repair
'Reparar a base de Dados de NOME DA MDB
Dim SourceFile, DestinationFile
SourceFile = "C:...
ome da mdb.mdb" ' Defineo ficheiro de origem.
DestinationFile = "c:\...
ome da mdb.mdb" ' Define o ficheiro de destino.
FileCopy SourceFile, DestinationFile ' Copia o ficheiro de origem para o ficheiro de destino.
DBEngine.RepairDatabase "C:\...
ome da mdb.mdb"
MsgBox "Base de dados das nome da mdb reparada com Sucesso!"
On Error GoTo 0
End If
Exit Function
Err_Repair:
For Each errLoop In DBEngine.Errors
MsgBox "Ocorreram erros na REPARAÇÓ¡O.Tente de Novo!" & vbCr & _
"Error number: " & errLoop.Number & _
vbCr & errLoop.Description
Next errLoop
End Function
Public Function backup()
Dim X, Y As Integer
Dim stAppName As String
MsgBox "Insira a disquete na Drive A:"
stAppName = "C:\...\Arj.exe a -vva a:
ome da mdb c:\...
ome da mdb.mdb /y"
Call Shell(stAppName, 1)
End Function
Public Function restaurar()
Dim X, Y As Integer
Dim stAppName As String
MsgBox "Insira a disquete com o Backup na Drive A:"
stAppName = "C:\...\Arj.exe e -vva a:
ome da mdb c:\...
ome da mdb.mdb /y"
Call Shell(stAppName, 1)
End Function
‘Para access2000 referenciar DAO 3.6
Public Function compactar()
Dim nomeant As String, nomeact As String
Dim SourceFile, DestinationFile
MsgBox "Certifique-se de que todos os utilizadores estão com as bases de Dados Encerradas."
If MsgBox("Compactar as bases de Dados?", _
vbYesNo) = vbYes Then
Kill "\...
ome da mdbant.mdb"
'Compactar base de dados NOME DA MDB
'DBEngine.CompactDatabase "base_normal", "base_compactada", dbLangGeneral, dbVersion30, ";pwd=senha"
DBEngine.CompactDatabase "\...
ome da mdb.mdb", "\...
ome da mdbtemp.mdb", dbLangGeneral & ";pwd=pass", dbEncrypt, ";pwd=pass"
SourceFile = "\...
ome da mdb.mdb" ' Define o nome do ficheiro de origem.
DestinationFile = "\...
ome da mdbant.mdb" ' Define o nome do ficheiro de destino.
FileCopy SourceFile, DestinationFile ' Copia o ficheiro de origem para o de destino.
Kill "\...
ome da mdb.mdb"
nomeant = "\...
ome da mdbtemp.mdb"
nomeact = "\...
ome da mdb.mdb"
Name nomeant As nomeact
MsgBox "Base de dados compactada com sucesso!"
End If
End Function
Public Function reparar()
Dim errLoop As Error
MsgBox "ATENÇÃO.Certifique-se de que todos os utilizadores estão com as bases de Dados Encerradas."
If MsgBox("Reparar a base de Dados nome da mdb.MDB?", _
vbYesNo) = vbYes Then
Kill "c:\seg
ome da mdb.mdb"
On Error GoTo Err_Repair
'Reparar a base de Dados de NOME DA MDB
Dim SourceFile, DestinationFile
SourceFile = "C:...
ome da mdb.mdb" ' Defineo ficheiro de origem.
DestinationFile = "c:\...
ome da mdb.mdb" ' Define o ficheiro de destino.
FileCopy SourceFile, DestinationFile ' Copia o ficheiro de origem para o ficheiro de destino.
DBEngine.RepairDatabase "C:\...
ome da mdb.mdb"
MsgBox "Base de dados das nome da mdb reparada com Sucesso!"
On Error GoTo 0
End If
Exit Function
Err_Repair:
For Each errLoop In DBEngine.Errors
MsgBox "Ocorreram erros na REPARAÇÓ¡O.Tente de Novo!" & vbCr & _
"Error number: " & errLoop.Number & _
vbCr & errLoop.Description
Next errLoop
End Function
Public Function backup()
Dim X, Y As Integer
Dim stAppName As String
MsgBox "Insira a disquete na Drive A:"
stAppName = "C:\...\Arj.exe a -vva a:
ome da mdb c:\...
ome da mdb.mdb /y"
Call Shell(stAppName, 1)
End Function
Public Function restaurar()
Dim X, Y As Integer
Dim stAppName As String
MsgBox "Insira a disquete com o Backup na Drive A:"
stAppName = "C:\...\Arj.exe e -vva a:
ome da mdb c:\...
ome da mdb.mdb /y"
Call Shell(stAppName, 1)
End Function
Tópico encerrado , respostas não são mais permitidas