3/5 (11 avis)
Vue 7 389 fois - Téléchargée 696 fois
'************************************************************** '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
12 mai 2006 à 11:24
8 févr. 2006 à 11:04
sShortName = oFSO.GetParentFolderName(sLocalDatabase) & "" & oFSO.GetBaseName(sLocalDatabase)
Pour Patate, si c'est tout à fait possible, le fso ici sert surtout à la manipulation des fichiers, tu peux utiliser les fonctions vb de base come filecopy, kill, etc...
30 janv. 2005 à 01:13
26 nov. 2004 à 03:06
25 nov. 2004 à 19:45
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.