jonathanchye
Registered User.
- Local time
- Today, 13:00
- Joined
- Mar 8, 2011
- Messages
- 448
Sorry if this is posted before but I thought I will contribute back after the awesome help I've got here 
What I have is a Compact & Repair code specifically for split backends. I have tested this to be working with .accdb files and I am pretty sure it will be easy to modify to accomdate .mdb files.
The code will first check if the backend is opened by checking for a record locking file (.laccdb). If the that file doesn't exist we can be 99% sure the backend is not being opened and ready for a Compact & Repair!
The code will also create a backup of the original file so you can easily revert back if possible and it is also handy to see how much space you've saved I've also built in basic error checking which can be improved upon.
I am running this on a remote server on a timed event so every night this code runs and tries to compact & repair the backends. I have a log file which keeps track of which process failed and which didn't
You will need to create a new module. I have called this "basCompactBE". Paste the code below in this new module :
This is an example of how I use this module :
What I have is a Compact & Repair code specifically for split backends. I have tested this to be working with .accdb files and I am pretty sure it will be easy to modify to accomdate .mdb files.
The code will first check if the backend is opened by checking for a record locking file (.laccdb). If the that file doesn't exist we can be 99% sure the backend is not being opened and ready for a Compact & Repair!
The code will also create a backup of the original file so you can easily revert back if possible and it is also handy to see how much space you've saved
I've also built in basic error checking which can be improved upon. I am running this on a remote server on a timed event so every night this code runs and tries to compact & repair the backends. I have a log file which keeps track of which process failed and which didn't
You will need to create a new module. I have called this "basCompactBE". Paste the code below in this new module :
Code:
Option Compare Database
Option Explicit
Public Function CheckLock(strPath As String) As Boolean
' This checks with the record locking file exists (backend is open if it exist
If Len(Dir(strPath)) = 0 Then
' doesn't exist
' MsgBox "False"
CheckLock = False
Else
' MsgBox "True"
CheckLock = True
End If
End Function
Function CompactBackend(strPath As String, strFileName As String) As Boolean
'strPath is the path to the folder containing your backend
'strFileName is the backend's full filename ie "my_Backend.accdb"
On Error GoTo Err_CompactBackend
Dim mNewPath As String
Dim mPath As String
'Names the compacted DB with _Compacted suffix
mNewPath = strPath & "\" & Left(strFileName, InStr(strFileName, ".") - 1) & "_Compacted.accdb"
mPath = strPath & "\" & strFileName
'Delete old _Compacted file if exist
If Len(Dir(mNewPath)) Then
Kill mNewPath
End If
'MsgBox "Compacting database"
Application.CompactRepair LogFile:=True, SourceFile:=mPath, DestinationFile:=mNewPath
' If this is successful then we rename the source file with the compacted one
'First backup the old uncompacted source file
Dim tempPath, tempPath2 As String
tempPath2 = mPath
'Adds a _Backup suffix
tempPath = strPath & "\" & Left(strFileName, InStr(strFileName, ".") - 1) & "_Backup.accdb"
'Make a backup copy of the Source file
FileCopy mPath, tempPath
'Kill the original file
Kill mPath
'Rename the new compacted file to original filename
Name mNewPath As tempPath2
CompactBackend = True
'MsgBox "Done Compacting database"
Exit_CompactBackend:
Exit Function
Err_CompactBackend:
MsgBox Err.Description
CompactBackend = False
Resume Exit_CompactBackend
End Function
Code:
Public Sub CompactBE()
On Error GoTo Err_Handler
DoCmd.SetWarnings False
If CheckLock("X:\Access Databases\xxx\BE\xxx_be.laccdb") = False Then
If CompactBackend("X:\Access Databasesxxx\BE", "xxx_be.accdb") = True Then
Me.Last_Process_Ran = "Compacted xxx_be.accdb"
Me.Last_Process_Ran_Timestamp = Now()
Me.Form_Name = "frmScheduler1"
Me.Online_status = True
DoCmd.RunCommand acCmdSaveRecord
DoCmd.GoToRecord acActiveDataObject, , acNewRec
Else
Me.Last_Process_Ran = "Failed to compact xxx_be.accdb"
Me.Last_Process_Ran_Timestamp = Now()
Me.Form_Name = "frmScheduler1"
Me.Online_status = True
DoCmd.RunCommand acCmdSaveRecord
DoCmd.GoToRecord acActiveDataObject, , acNewRec
End If
Else
Me.Last_Process_Ran = "Backend Open xxx_be.accdb"
Me.Last_Process_Ran_Timestamp = Now()
Me.Form_Name = "frmScheduler1"
Me.Online_status = True
DoCmd.RunCommand acCmdSaveRecord
DoCmd.GoToRecord acActiveDataObject, , acNewRec
End If
