CompToNewMDB

[Duane]

I am using a routine that compacts the backend database to a new db
(Access2002). The backend database is password protected. When the routine
executes, the user has to enter the password that is set on the backend
database.

Is it possible to pass the password value in the function so the end user
doesn't have to enter the password? Thank you in advance.


Code:
If datBackUp < Date Then

intResponse = MsgBox("Do you want to exit and make a backup copy?",
vbYesNo + vbQuestion, "")

Select Case intResponse

Case Is = vbYes


'Find Dir so we know what to name the new backup
strDir = Left(COMPACTTO, InStrRev(COMPACTTO, "\"))

'Find first file in Dir
strBkp = Dir(strDir & "\ARFTools_be*.mdb")

'loop through directory and count the number of files
Do While Len(strBkp) > 0
intBkp = intBkp + 1
If (strBkp < strLowBkp) Or (Len(strLowBkp) = 0) Then strLowBkp =
strBkp
strBkp = Dir

'create a total of 3 old files
Loop

If intBkp > 3 Then
Kill strDir & strLowBkp
End If

Case Is = vbNo
MsgBox "All data has been save but there was not a backup copy
made of the database", vbOKOnly + vbExclamation, ""
DoCmd.Quit acQuitSaveAll

End Select


'Call the CompactToNewMDB function to create a new backup file
CompactOK = CompactToNewMDB(COMPACTFROM, COMPACTTO, True)

Db.Execute "UPDATE ztblVersion SET LastBackUp = #" & Now & "#",
dbFailOnError
MsgBox "The database has been backed up"

'Close Application
DoCmd.Quit
Else

'Don't make a backup
DoCmd.Quit
End If
End If


Function CompactToNewMDB(mdbFrom As String, mdbTo As String, Optional
deleteMdbTofirst As Boolean) As Boolean
On Error GoTo CompactToNewMDB_Error

If IsMissing(deleteMdbTofirst) Then
deleteMdbTofirst = False
End If

If deleteMdbTofirst Then

If Len(Dir(mdbTo)) > 0 Then
Kill mdbTo
End If
End If

'Create new backup file
CompactToNewMDB = Application.CompactRepair(mdbFrom, mdbTo)

CompactToNewMDB_Exit:
Exit Function


CompactToNewMDB_Error:
If Err.Number = 7866 Or Err.Number = 31523 Then
Resume CompactToNewMDB_Exit
Else
MsgBox "Error number" & " " & Err.Number & _
vbNewLine & "Error Description " & Err.Description
Resume CompactToNewMDB_Exit
End If
End Function

 

[Frank H]

I don't know about doing it directly, but how using the code to remove the
password before the backup, and then reapplying the password with code
afterward?

I found this article...
http://support.microsoft.com/kb/170961

Sub ChangeDBPassword ()
Dim Db As Database

Set Db = OpenDatabase("C:\My Documents\MyDB.mdb",True, _
False,";pwd=MyPassword1")
Db.NewPassword "MyPassword1","MyPassword2"
Db.Close
End Sub

 

[Tony Toews [MVP]]

I am using a routine that compacts the backend database to a new db
(Access2002). The backend database is password protected.

CompactToNewMDB = Application.CompactRepair(mdbFrom, mdbTo)

Try the dbengine.CompactDatabase Method as it allows you to specify a
password and other parameters.

Tony