Compact and Repair Split Database

C

cpremo

Registered User.
Local time
Today, 07:28
Joined
Jun 22, 2007
Messages
50
I have many databases with Front-End (Forms, reports, modules) and Back-End (Tables) design. All tables in the Front-End are linked to the Back-End. What I've tried to do is use this code to "Compact and Repair" the Back-End database, but receive the following error message: "You attempted to open a database that is already opened exclusively by user 'Admin' on machine 'xxxxxx'. Try again when the database is available."

Any ideas on how to correct the code to allow me to compact the active "Back-End" database from a command button on the "Front-End" database?


****************************************************
Function CompactBackend()

Dim je As New JRO.JetEngine
Dim mNewPath As String
Dim mPath As String
Dim strPath As String
strPath = Forms![MainMenu]![Database Location]
'Change the database name to point to your database.
'Give a new name to the destination database, mNewPath preferably "OLDNAME_New.mdb"
'The mNewPath should not necessarily exist, but should becreated after the first
'sucessfull compact

mNewPath = strPath & "\Testq_New.mdb" 'New as a result of compact
mPath = strPath & "\Server Config Files Tables.mdb" 'Original Database

If Len(Dir(mNewPath)) Then ' Test to see if the database exist from
MsgBox " Hello new database from Compact exist! Deleting it"
Kill mNewPath
End If

If Len(Dir(mPath)) Then ' Test to see if the database exist from
MsgBox "You have the original database"
End If

MsgBox "Compacting database"
je.CompactDatabase SourceConnection:="Data Source= " & mPath, _
DestConnection:="Data Source= " & mNewPath & ";" & _
"Jet OLEDB:Encrypt Database=True"

MsgBox "Done Compacting database"

If Len(Dir(mPath)) Then ' Test to see if the database exist from
MsgBox "I am deleting the original database and copy the new to it"
Kill mPath
End If
If Len(Dir(mNewPath)) Then ' Test to see if the database exist from
MsgBox "New from Compact Say Hello"
End If

MsgBox "Copying file from new to original"
FileCopy mNewPath, mPath

End Function
 
The problem is that either someone is using a Front-End that is updating/retrieving data from the backend. Or, there is no one else in the front-end and your database's form or some control is bound to a linked table, forcing the back-end to have an lock file (.ldb) associated with it.
 
That was the answer. I closed the "MainMenu" with the command:

DoCmd.Close acForm, "MainMenu"

then re-opened the form with the command:

DoCmd.OpenForm "MainMenu"
 
Spoke too soon. When I run the code raw (from the visual basic editor), the process works. However, when I click the "cmdCompactTables" command button on the MainMenu, I still get the error:

"You attempted to open a database that is already opened exclusively by user 'Admin' on machine 'xxxxxx'. Try again when the database is available."

So, how do I clear the "connection" with the back-end in the process.
 
Do not use a bound form to do the work. Have a hidden form that opens first and is not bound to any table or query. Use this form to do your housekeeping chores and it could also be used to stop the user from closing the db if you want. Since it should be the first form to open, it will be the last form to close.
 
You cannot have any bound form, control, or object associated with a linked table of the database you want to compact/repair open while you are doing it.

This includes any DAO/ADO recordsets that you have opened. Everything bound must be closed when running the compact/repair.

Either run the command from a form that is unbound, or when running the script, include a UnbindObjects() function that changes the recordset.

Hint:
I reset all recordset and rowsource of objects on my form (including my form) when I close. I also save the recordset/rowsource information in the control's "Tag" information, so that I can load it back up during the form's open/load event.

You can do something similar when running the compact/repair. Do Call SaveFormInfoToTag and then Call ClearControlSources

Code: 
[color=blue]Public Function[/color] SaveFormInfoToTag()
    [color=blue]Dim[/color] ctl [color=blue]As[/color] Control

    Me.Tag = Me.RecordSource

    [color=blue]For Each[/color] ctl In Me.Controls
        [color=blue]Select Case[/color] ctl.Properties("ControlType")
            [color=blue]Case[/color] acComboBox, acListBox
                ctl.Tag = ctl.RowSource
            [color=blue]Case[/color] acSubform
                ctl.Form.Tag = ctl.Form.Recordsource
            [color=blue]Case Else[/color]
                'do nothing
        [color=blue]End Select[/color]
    [color=blue]Next ctl[/color]

    [color=blue]Set[/color] ctl = Nothing
[color=blue]End Function[/color]

[color=blue]Public Function[/color] ClearControlSources()
    [color=blue]Dim ctl [color=blue]As[/color] Control
    Me.RecordSource = ""

    [color=blue]For Each[/color] ctl In Me.Controls
        [color=blue]Select Case[/color] ctl.Properties("ControlType")
            [color=blue]Case[/color] acComboBox, acListBox
                ctl.RowSource = ""
                ctl.Requery
            [color=blue]Case[/color] acSubform
                ctl.Form.RecordSource = ""
            [color=blue]Case Else[/color]
                'do nothing
        [color=blue]End Select[/color]
    [color=blue]Next[/color] ctl

    [color=blue]Set[/color] ctl = Nothing
[color=blue]End Function[/color]


[color=blue]Private Sub[/color] Form_Load()
    [color=blue]Dim[/color] ctl [color=blue]As[/color] Control
    Me.RecordSource = Me.Tag

    [color=blue]For Each[/color] ctl In Me.Controls
        [color=blue]Select Case[/color] ctl.Properties("ControlType")
            [color=blue]Case[/color] acComboBox, acListBox
                ctl.RowSource = ctl.Tag
            [color=blue]Case[/color] acSubform
                ctl.Form.RecordSource = ctl.Form.Tag
            [color=blue]Case Else[/color]
                'do nothing
        [color=blue]End Select[/color]
    [color=blue]Next[/color] ctl

    [color=blue]Set[/color] ctl = [color=blue]Nothing[/color]
[color=blue]End Sub[/color]
 
Last edited:
That did it, thanks. I was able to execute the module and compact the back-end database.

*********************************
Function CompactBackend()
On Error GoTo Err_CompactBackend
'*******************************************************************************
'Name: CompactBackend
'Purpose: 'This function is used to compact the "BackEnd" tables.
'Author: Chris Premo
'Date: June 22, 2007
'Called by: The Function is called by the "cmdCompactTables" command button on the Main Menu.
'
'*******************************************************************************

Dim je As New JRO.JetEngine
Dim mNewPath As String
Dim mPath As String
Dim strPath As String
strPath = Forms![MainMenu]![Database Location]
'Change the database name to point to your database.
'Give a new name to the destination database, mNewPath preferably "OLDNAME_New.mdb"
'The mNewPath should not necessarily exist, but should becreated after the first
'sucessfull compact
Call SaveFormInfoToTag
Call ClearControlSources
DoCmd.Close acForm, "MainMenu"
mNewPath = strPath & "\Testq_New.mdb" 'New as a result of compact
mPath = strPath & "\Server Config Files Tables.mdb" 'Original Database

If Len(Dir(mNewPath)) Then ' Test to see if the database exist from
Kill mNewPath
End If

MsgBox "Compacting database"
je.CompactDatabase SourceConnection:="Data Source= " & mPath, _
DestConnection:="Data Source= " & mNewPath & ";" & _
"Jet OLEDB:Encrypt Database=True"
MsgBox "Done Compacting database"

If Len(Dir(mPath)) Then ' Test to see if the database exist from
Kill mPath
End If

FileCopy mNewPath, mPath
DoCmd.OpenForm "MainMenu"

Exit_CompactBackend:
Exit Function

Err_CompactBackend:
MsgBox Err.Description
Resume Err_CompactBackend

End Function

Public Function SaveFormInfoToTag()
Dim ctl As Control

Forms![MainMenu].Tag = Forms![MainMenu].RecordSource

For Each ctl In Forms![MainMenu].Controls
Select Case ctl.Properties("ControlType")
Case acComboBox, acListBox
ctl.Tag = ctl.RowSource
Case acSubform
ctl.Form.Tag = ctl.Form.RecordSource
Case Else
'do nothing
End Select
Next ctl

Set ctl = Nothing
End Function

Public Function ClearControlSources()
Dim ctl As Control
Forms![MainMenu].RecordSource = ""

For Each ctl In Forms![MainMenu].Controls
Select Case ctl.Properties("ControlType")
Case acComboBox, acListBox
ctl.RowSource = ""
ctl.Requery
Case acSubform
ctl.Form.RecordSource = ""
Case Else
'do nothing
End Select
Next ctl

Set ctl = Nothing
End Function

Private Sub Form_Load()
Dim ctl As Control
Forms![MainMenu].RecordSource = Forms![MainMenu].Tag

For Each ctl In Forms![MainMenu].Controls
Select Case ctl.Properties("ControlType")
Case acComboBox, acListBox
ctl.RowSource = ctl.Tag
Case acSubform
ctl.Form.RecordSource = ctl.Form.Tag
Case Else
'do nothing
End Select
Next ctl

Set ctl = Nothing
End Sub
 
When you post code on the forum, please use the code wrapper to format so that it displays with the regular code formatting. To do that you type the word code and put square brackets [] around the word, "code" and then at the end of the code you type /code inside the square brackets.
 
This was exactly what I search for, thanks guys, you saved my day. :)
 
Is the cmdCompactTables function called as a button on your "main menu?" or is it automatically executed when the Front End is opened by a user?
 
You must log in or register to reply here.

Similar threads

A
Solved Adding Items to Combobox, but They aren't showing up
2
Replies
21
Views
979
AngelSpeaks
A
Z
Finding and opening a hyperlink
Replies
3
Views
269
zebrafoot
Z
A
Solved VBA compact-and-repair of a closed (corrupted) database from a new, blank Access file
2
Replies
24
Views
1,467
isladogs
isladogs
A
Solved External Database Update Connection String
Replies
9
Views
349
Pat Hartman
P
B
Splitting database
Replies
10
Views
565
The_Doc_Man
The_Doc_Man

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom