[AccessD] Compact BE on Close - An Example

What do you do with multi-user apps?  You don't want ot compabt the
back-end while othr users have an open connection, do you?

Maybe I'm retentive, but I wrote a VB utility that compacts a
database.  It runs as a scheduled service on the server.  My clients
usually have it set to fire at midnight or thereabouts.

-C-

---- Original Message ----
From: dwaters at usinternet.com
To: accessd at databaseadvisors.com, 
Subject: RE: [AccessD] Compact BE on Close - An Example
Date: Wed, 25 Aug 2004 09:12:27 -0500

>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
>

Respectfully,

Christopher Hawkins
Managing Developer
http://www.christopherhawkins.com