ERRO AO COMPACTAR BANCO DE DADOS

EVERSON.PASETTO 17/12/2006 16:20:49
#190449
Tenho um banco de dados e esta dando erro ao compactar o banco....

Clico em compactar e dá erro....

Há, o banco esta com senha, e a senha é 12345

No programa coloquei uns comentários explicando os tipos de erros que está acontecendo....


Porque esta dando estes erros???

Obrigado e até +
USUARIO.EXCLUIDOS 17/12/2006 16:44:34
#190450
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=merc290901;"
DB_destino = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & destino_path & " ;Jet OLEDB:Database Password=merc290901;Engine Type=5"

JRO.CompactDatabase DB_origem, DB_destino

compactaDB = True
Exit Function

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







'001 - Reparar Banco de Dados
If MsgBox("Confirma Compactar e Reparar Banco de Dados ?", vbQuestion + vbYesNo, "Confirmação") = vbYes Then
Conexao.Close'Fecha conexao
Me.MousePointer = 13
Dim origem_path, destino_path As String
origem_path = Bancosemcompactação 'Caminho Banco Original
destino_path = BancoCompactado 'Caminho Banco Compactado

If Not compactaDB(origem_path, destino_path) Then ' Se algum erro acontecer
ConectaBanco'abre conexão novamente
MsgBox "Ocorreu um erro durante a compactacao " & vbCrLf & vbCrLf & Loc2, vbExclamation
Else
Kill origem_path 'Exclui Banco sem Compactação
Name destino_path As origem_path 'Renomeia o Banco Compactado
Me.MousePointer = 0
MsgBox "Compactado com Sucesso", vbInformation, "Aviso"
ConectaBanco'abre coxexao
End If
End If
'001************
CLEVERTON 18/12/2006 01:04:52
#190497
Vc tem que fechar a conexao pra compactar
EVERSON.PASETTO 18/12/2006 08:15:29
#190526
Bem, mudei o codigo agora, e o banco de dados só é chamado (aberto) após a compactação....

Mas mesmo assim ficou dando um errinho só, não compacata, ou seja na linha

Dá erro 424

Aqui esta dando o erro, acho que falta algo no codigo
'Dá erro 424 - Object Required
DBEngine.CompactDatabase App.Path & "\Dados\TempDB.mdb", False, False, ";pwd=12345", dbpath

Podem olhar o novo anexo que estou enviando...

Obrigado e até mais
EVERSON.PASETTO 18/12/2006 10:59:43
#190575
Continua dando erro....

Agora é erro 3421


Está quase funcionando


E estou usando conexão ADO

Olhem o novo anexo
EVERSON.PASETTO 18/12/2006 14:22:00
#190638
Esta dando erro 3421....

E tenho 2 pcs com Sistema Operacional diferentes e nos dois dá o mesmo erro.....
HUGOSSOUZA 18/12/2006 14:44:03
#190651 Resposta escolhida
tenta assim e troca o DAO 3.6 pelo 2.5/3.51... o 3.6 não aceita essa compactação

Private Sub mnucompactar_Click()

Dim dbpath As String
dbpath = App.Path & "\cliente.mdb"

'On Error GoTo ErrorDes
Screen.MousePointer = vbHourglass
If dbpath = "" Then
   MsgBox "Não foi encontrada a Base de Dados", vbExclamation, "Compactação da Base deDados"
   FileCopy App.Path + "\dados\TempDB.mdb", dbpath
Else
   If Dir(dbpath) = "" Then
      MsgBox "Não foi encontrada a Base de Dados", vbExclamation, "Compactação da Base deDados"
      FileCopy App.Path + "\dados\TempDB.mdb", dbpath
   Else

      FileCopy dbpath, App.Path + "\Dados\TempDB.mdb"
      Kill dbpath

      'Aqui esta dando erro
      'DBEngine.CompactDatabase App.Path & "\Dados\TempDB.mdb", False, False, dbpath
      If Dir(App.Path & "\TempDB.Mdb") <> "" Then Kill App.Path & "\TempDB.Mdb" 'Verifica se o arquivo existe, e deleta
      DBEngine.CompactDatabase App.Path & "\Dados\TempDB.mdb", App.Path & "\TempDB.Mdb", dbLangGeneral & "; pwd=12345", , "; pwd=12345"

      If Dir(dbpath) <> "" Then

         MsgBox "Compactação falhou, por favor tente novamente ", vbExclamation, "Compactação da Base de Dados"
         FileCopy App.Path + "\dados\TempDB.mdb", dbpath
         'lblPercentage = "Restore the database"
         Screen.MousePointer = vbDefault
         Exit Sub
      Else
         Kill App.Path + "\TempDB.mdb"
      End If



      MsgBox "Compactação efectuada com sucesso.", vbInformation, "Compactação da Base de Dados"


   End If
End If

Screen.MousePointer = vbDefault

Exit Sub

ErrorDes:
FileCopy App.Path + "\dados\TempDB.mdb", dbpath
MsgBox Err.Description, vbCritical, Err.Number

Screen.MousePointer = vbDefault
FileCopy App.Path + "\dados\TempDB.mdb", dbpath



End Sub
Tópico encerrado , respostas não são mais permitidas
Voltar