Sub Change_UserPassword()
Dim cat As ADOX.Catalog
Dim strDB As String
Dim strSysDb As String
On Error GoTo ErrorHandle
strDB = CurrentProject.Path & "\mydb.mdb"
strSysDb = "C:\System.mdw"
Set cat = New ADOX.Catalog
With cat
.ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source='" & strDB & "';" & _
"Jet OLEDB:System Database='" & strSysDb & "';" & _
"User Id=Admin;Password=;"
.Users("Admin").ChangePassword " ", "secret"
End With
ExitHere:
Set cat = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description
GoTo ExitHere
End Sub