COMPRIMER UNE BASE ACCESS

Function Compactdatabase(dbpfad As String, dbname As String) As Boolean 

    
    Dim fs As New FileSystemObject
    Dim testcopy As Boolean
    Dim db1 As String
    Dim db2 As String
    
   On Error GoTo compactdb_error
   
    If Dir(dbpfad & "\dbtemp.mdb") <> "" Then Kill dbpfad & "\dbtemp.mdb"
   
   'compression
   db1 = UCase(dbpfad & "\" & dbname)
   db2 = UCase(dbpfad & "\dbtemp.mdb")
   
   DBEngine.Compactdatabase db1, db2, , dbEncrypt + dbVersion40 'Jet version
     
   'renome
    
    fs.CopyFile db2, db1
    Compactdatabase = True
    GoTo ende
   
compactdb_error:
    Compactdatabase = False
    
    MsgBox (Err.Description)
    
ende:

End Function