[AccessD] Compact BE on Close - An Example

We simply include a Compact button in our application that allows the
user to compact the BE on demand.  Both our front and back ends are
secured, so we open a secured workspace to perform the compact.

Charlotte Foust


-----Original Message-----
From: Dan Waters [mailto:dwaters at usinternet.com] 
Sent: Wednesday, August 25, 2004 7:12 AM
To: Database Advisors
Subject: [AccessD] Compact BE on Close - An Example


Hello to All!

I've believed for a while that setting Compact On Close for the FE would
also compact the BE.  But a little testing disproved that.  For the BE
to auto-compact, it must actually be opened by the Access application
and then closed.

With some help from Stephen Bond, I was able to put together this code
to compact the BE when the FE is closed by the last person.

Two things about the BE: First - you must set its Compact On Close
option to true.  Second - avoid User Security on the BE or your users
will be asked to enter their user name and password as they are shutting
down their FE.

You should be controlling the FE so that pushing an Exit or Quit button
is the only way the FE can be closed.  (Discussed in previous posts.)
When you push that button, call the CompactBE procedure immediately
before using the DoCmd.Quit method.

I've used this successfully at one customer site.  I hope this will work
for everyone - if you see any problems with this then speak up!

Thanks!
Dan Waters
ProMation Systems, Inc.

PS - I'm going to try to see if this is publishable information.



'-- Paste the following into a Standard Module titled 'Compact BE' 

Option Compare Database
Option Explicit

Public Sub CompactBE()
On Error GoTo EH

    Dim stgPath As String
    Dim blnExclusive As Boolean
    Dim appAccess As Access.Application
    Dim varReturn As Variant
    
    If CountCurrentUsers > 1 Then
        Exit Sub
    End If
    
    stgPath = "\\ServerPath\SystemFolder\BackEnd\BE.mdb"
    '-- Keep users out while the BE is compacting
    blnExclusive = True
    
    Set appAccess = New Access.Application
    
    varReturn = SysCmd(acSysCmdSetStatus, "Compacting BE")
    
    appAccess.OpenCurrentDatabase stgPath, blnExclusive
    '-- When the BE closes it will auto-compact.  And it happens
quickly!
    appAccess.CloseCurrentDatabase
    appAccess.Quit
    
    varReturn = SysCmd(acSysCmdClearStatus)
    
    Exit Sub
    
EH:
    Application.Echo True
    Call GlobalErrors("", Err.Number, Err.Description, "Compact BE",
"CompactBE")

End Sub

Public Function CountCurrentUsers() As Integer
On Error GoTo EH

    Dim con As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim stgAccessVersion As String
    Dim intUserCount As Integer
    Dim stgUserName As String
    
    stgAccessVersion = SysCmd(acSysCmdAccessVer)

    '-- The user roster is exposed as a provider-specific schema rowset
_
        in the Jet 4.0 OLE DB provider.  You have to use a GUID to _
        reference the schema, as provider-specific schemas are not _
        listed in ADO's type library for schema rowsets

    Select Case stgAccessVersion
        Case "9.0"
            '-- This is from MSKB 198755 and is specific to Access 2000
            con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=\\ServerPath\SystemFolder\FrontEnd\FE.mdb"
        Case "10.0"
            '-- This is from MSKB 285822 and is specific to Access 2002
or 2003
            Set con = CurrentProject.Connection
        Case "11.0"
            '-- This is from MSKB 285822 and is specific to Access 2002
or 2003
            Set con = CurrentProject.Connection
    End Select

    Set rst = con.OpenSchema(adSchemaProviderSpecific, ,
"{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    
    If rst.EOF = False Then
        Do While rst.EOF = False
            stgUserName = Left$(rst.Fields(1), InStr(1, rst.Fields(1),
Chr(0)) - 1)
            If stgUserName <> "Admin" Then
                intUserCount = intUserCount + 1
            End If
            rst.MoveNext
        Loop
        CountCurrentUsers = intUserCount
    Else
        CountCurrentUsers = 0
    End If
    
    rst.Close
    Set rst = Nothing

    Exit Function
    
EH:
    Application.Echo True
    Call GlobalErrors("", Err.Number, Err.Description, "Count Current
Users", "CountCurrentUsers")
    
End Function


-- 
_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com