COMPACTER ET REPARER UNE BASE DE DONNÉE

Public Sub Compactage(Fichier As String)

Dim fs As Object
Dim db As New DBEngine

MousePointer = 11

Set fs = CreateObject("Scripting.FileSystemObject")

If Not (fs.FileExists(Fichier)) Then ' Verification de la Présence du Fichier
    MsgBox "Base Introuvable à l'endroit spécifié", vbCritical + vbOKOnly, "Erreur"
    Exit Sub
End If

If fs.FileExists(Mid(Fichier, 1, Len(Fichier) - 4) & ".ldb") Then ' Verification de la Présence du Fichier .ldb
    MsgBox "La Base est déja Ouverte, Impossible de Poursuivre", vbCritical + vbOKOnly, "Erreur"
    Exit Sub
End If

db.CompactDatabase Fichier, "C:\Tempo.mdb" ' Compactage de la Base dans une Base Tempo

fs.DeleteFile Fichier ' Suppression de la Base
fs.MoveFile "C:/Tempo.mdb", Fichier ' Renommage de la Base Tempo

MsgBox "La Base de Donnée : " & Fichier & Chr$(13) & " est Compactée.", vbInformation, "Compactage"

MousePointer = 1

End Sub

Public Sub Reparation(Fichier As String)

Dim fs As Object
Dim db As New DBEngine
Dim errLoop As Error

On Error GoTo Err_Reparation

MousePointer = 11

Set fs = CreateObject("Scripting.FileSystemObject")

If Not (fs.FileExists(Fichier)) Then ' Verification de la Présence du Fichier
    MsgBox "Base Introuvable à l'endroit spécifié", vbCritical + vbOKOnly, "Erreur"
    Exit Sub
End If

db.RepairDatabase Fichier

MsgBox "La Base de Donnée : " & Fichier & Chr$(13) & " est Réparée.", vbInformation, "Réparation"

MousePointer = 1

On Error GoTo 0

Exit Sub

Err_Reparation:

   For Each errLoop In db.Errors
      MsgBox "Numéro d'erreur : " & errLoop.Number & _
         vbCr & errLoop.Description
   Next errLoop

End Sub