Function ChangeAccessPassword(ByVal sPath As String, ByVal sOldPassword As String, ByVal sNewPassword As String, Optional ByVal iJetEngine As Integer = 5) As Boolean
' nécessite msjro.dll (Microsoft Jet And Replication Objects 2.6 Library)
'sPath chemin complet de la DB ACCESS, valide et non-connectée !
'sOldPassword ancien mot de passe, VALIDE !
'sNewPassword nouveau mot de passe
'iJetEngine type de base. 1 = Jet10
' 2 = Jet11
' 3 = Jet20 (Access 2)
' 4 = Jet3x (Access 97)
' 5 = Jet4x (Access 2000, XP-2002, 2003)
Dim sTempDB As String
Dim oJE As New JetEngine
' chemin temporaire
sTempDB = GetUniqueTempFileName(False) 'http://www.codyx.org/snippet_generer-nom-fichier-temporaire-unique_619.aspx
' on va passer par le compactage pour changer le mot de passe
On Local Error Resume Next
oJE.CompactDatabase "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & sPath & ";Jet OLEDB:Database Password=" & sOldPassword & ";Jet OLEDB:Engine Type=" & CStr(iJetEngine) & ";", _
"Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & sTempDB & ";Jet OLEDB:Database Password=" & sNewPassword & ";Je OLEDB:Engine Type=" & CStr(iJetEngine) & ";"
' pas d'erreur, on renomme
If Err.Number = 0 Then
On Error GoTo Err_Handler
Kill sPath
Name sTempDB As sPath
ChangeAccessPassword = True
Else
' détruit éventuelle base
Kill sTempDB
End If
Err_Handler:
Set oJE = Nothing
End Function