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:segome 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

NOTA:

   - Para ACCESS97 referenciar DAO 3.51

   - Para ACCESS2000 referenciar DAO 3.6

A compactação, no ACCESS2000 já inclui reparação.

João Mateus