Here is a couple of snippets of code to compact the date portion of a
database (Linked tables)
Written a long time ago for Access 97 but works OK for A2K
Think you clicked a button on a form
Table Paths contains information on the folder for the various bits of the
database
Table Users was a list of people logged on to the database (irrelevant for a
single user)
It then creates a copy of the Data.Mdb called something like Data.Bak
(Just in case)
Then rename Data.Mdb to Data.MdbOld
Then Compact Data.MdbOld calling Data.Mdb the original name
Then relink the tables
You may be able to adapt this if using a front end back end situation
Phil
Sub CompactData_Cli ck() ' Compact Database
Dim MyDb As Database
Dim PathSet As Recordset
Dim TDf As TableDef
Dim Pathname As String, FileName As String
Dim DataPath As String, OldDataPath As String, BakDataPath As String
Dim fs As Object
On Error GoTo CompactData_Err
' Check only 1 person (Current User) on System
If CheckUsers() > 1 Then Exit Sub ' Other users on system
ReturnValue = CloseForms()
Set MyDb = CurrentDb
Set PathSet = MyDb.OpenRecord set("Paths")
DataPath = PathSet!DataPat h
PathSet.Close
Set PathSet = Nothing
OldDataPath = DataPath & "Old"
BakDataPath = Left$(DataPath, (Len(DataPath) - 3)) & "Bak"
ReturnValue = SysCmd(acSysCmd SetStatus, "Copying Data Files")
If Dir(DataPath) <> "" Then ' Make sure that the data file
exists
Set fs = CreateObject("S cripting.FileSy stemObject")
fs.Copyfile DataPath, BakDataPath, True ' Copy Data to AMM
Services Data.Bak
If Dir(OldDataPath ) <> "" Then
Kill OldDataPath ' Delete Old File
End If
fs.moveFile DataPath, OldDataPath ' Rename Data to AMM
Services Data.MdbOld
Else
MsgBox "Can't find the Data", vbCritical
Exit Sub
End If
ReturnValue = SysCmd(acSysCmd SetStatus, "Compacting Database")
DBEngine.Compac tDatabase OldDataPath, DataPath
For Each TDf In MyDb.TableDefs ' Refresh the links
If Len(TDf.Connect ) > 0 Then
If TDf.Connect > "" Then 'Drive letter for client
database
TDf.RefreshLink
End If
End If
Next TDf
MsgBox "Database Compacted Succesfully", vbInformation
CompactData_Exi t:
ReturnValue = SysCmd(acSysCmd ClearStatus)
Exit Sub
CompactData_Err :
MsgBox Err.Description
MsgBox "You can restore the data from 'AMM Services Data.Bak'",
vbInformation
Resume CompactData_Exi t
End Sub
Function CloseForms()
Dim i As Integer
If Forms.Count > 1 Then ' Other Forms open
For i = 0 To Forms.Count - 1
If Forms(i).Name <> "Archive" And Forms(i).Name <> "Switchboar d"
Then
DoCmd.Close acForm, Forms(i).Name
End If
Next
End If
End Function
Function CheckUsers() As Integer
Dim MyDb As Database
Dim UserSet As Recordset
Dim SQLStg As String
SQLStg = "SELECT Users.UserName, Users.LoggedOn "
SQLStg = SQLStg & "FROM Users;"
Set MyDb = CurrentDb
Set UserSet = MyDb.OpenRecord set(SQLStg)
UserSet.MoveLas t
If UserSet.RecordC ount > 1 Then
MsgBox "There are other users on the system. The must be logged off
before proceeding", vbInformation
CheckUsers = UserSet.RecordC ount
End If
End Function
"lestersal" <le*******@cox. net> wrote in message
news:c0KAb.3296 3$Gj2.23357@oke pread01...
How would I compact a database on Open using code? I presume I'd have to
use the Autoexec macro but what code do I put in the procedure called by
Autoexec?
Thanks,
Alistair
