Ce code permet de compacter une base de données access protégée par un mot de passe. Ceci est nécessaire afin d'éviter que la base ne devienne énorme. Ce code est très rapide et léger en resources.
Dans votre projet faites référence à ces 3 Composants :
1. Microsoft Jet and Replication Objets 2.6 library
2. Microsoft DAO 3.6 Object Library
3. Microsoft Scripting Runtime
Source / Exemple :
'**************************************************************
'purpose : this code Compacts a database protected by a password
'
'Project References :
'--------------------
' 1. Microsoft Jet and Replication Objets 2.6 library
' 2. Microsoft DAO 3.6 Object Library
' 3. Microsoft Scripting Runtime
'**************************************************************
Option Explicit
'remplacer cette constante par votre mot de passe
Const c_sPASSWORD As String = "pwd"
Const c_sDATABASE As String = "MaBasedeDonnées.mdb"
Public Sub main()
'remplacer la DB par la votre
Dim sPath
sPath = App.Path
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
CompactDataBaseAccess sPath & c_sDATABASE, c_sPASSWORD
End Sub
'**************************************************************
'purpose : this sub compacts a database using JRO
'params: LocalDatabase : The actual db
' sPassword : The DB password
'
'**************************************************************
Public Sub CompactDataBaseAccess(sLocalDatabase As String, sPassword As String)
On Error GoTo ERRORHANDLER
Screen.MousePointer = vbHourglass
Dim oFSO As FileSystemObject
Dim oJRO As JRO.JetEngine
Dim sShortName As String, sExt As String
Dim sCompactPart1 As String
Dim sCompactPart2 As String
Set oFSO = New FileSystemObject
sShortName = oFSO.GetBaseName(sLocalDatabase)
sExt = ".Bak"
sShortName = sShortName & sExt
sCompactPart1 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
";Data Source=" & sLocalDatabase
sCompactPart2 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
";Data Source=" & sShortName
ChangeDBPassword "", sLocalDatabase
Set oJRO = New JRO.JetEngine
oJRO.CompactDatabase sCompactPart1, sCompactPart2
' delete the original database
oFSO.DeleteFile sLocalDatabase
oFSO.MoveFile sShortName, sLocalDatabase
ChangeDBPassword sPassword, sLocalDatabase
EXITPOINT:
Screen.MousePointer = vbDefault
If Not oFSO Is Nothing Then
Set oFSO = Nothing
End If
If Not oJRO Is Nothing Then
Set oJRO = Nothing
End If
Exit Sub
ERRORHANDLER:
Resume EXITPOINT
End Sub
'**************************************************************
'purpose : this sub changes the password of a database using DAO
'params: sPassword : The acutal db password
' SDatabase : The Database file Name
'
'**************************************************************
Private Sub ChangeDBPassword(sPassword As String, sLocalDatabase As String)
On Error GoTo ERRORHANDLER
Dim oMDBDatabase As Database
Select Case sPassword
Case c_sPASSWORD
Set oMDBDatabase = OpenDatabase(sLocalDatabase, True, False)
oMDBDatabase.NewPassword "", c_sPASSWORD
Case Else
Set oMDBDatabase = OpenDatabase(sLocalDatabase, True, False, _
";pwd=" & c_sPASSWORD)
oMDBDatabase.NewPassword c_sPASSWORD, ""
End Select
oMDBDatabase.Close
EXITPOINT:
Exit Sub
ERRORHANDLER:
Resume EXITPOINT
End Sub
Conclusion :
JDS
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.