Sub Change_DBPassword()
Dim jetEng As JRO.JetEngine
Dim strCompactFrom As String
Dim strCompactTo As String
Dim strPath As String
On Error GoTo ErrHandle
strPath = CurrentProject.Path & "\"
strCompactFrom = "mydb.mdb"
strCompactTo = "mydb_.mdb"
Set jetEng = New JRO.JetEngine
jetEng.CompactDatabase "Data Source=" & strPath & strCompactFrom & ";", _
"Data Source=" & strPath & strCompactTo & ";" & _
"Jet OLEDB:Database Password=welcome"
ExitHere:
Set jetEng = Nothing
Exit Sub
ErrHandle:
If Err.Number = -2147217897 Then
Kill strPath & strCompactTo
Resume
Else
MsgBox Err.Number & ": " & Err.Description
Resume ExitHere
End If
End Sub
|