DB Grows, possible to auto compact DB?

[ChaseCox]

Hello All,

I was wondering if anyone had ever experienced this.

When ever I use my DB, it continues to get larger. Is there away to automatically compact the database upon closing or opening? Any help would be greatly apprecited.

If you need some more information, please let me know.

[Denburt]

In the Access Database window go to the tools menu then Options Click the general tab and click on Compact on Close. I can also show you how it can be done in code if you would like.

[Denburt]

You might check out the possibility of adding compact on the right click menu when your in explorer.

Right Click Compact menu

[ChaseCox]

Thanks for the quick response. Would you mind showing me how to do this with code. I can not seem to find that option in my options tab selections. I am using access 97

[Denburt]

Well i'll be i have a whole slew of DB's here that i am managing and I thought for sure it was in one of them evidently not. must be in some of my older work. I did find it in VBS but that won't help in VBA. Anyhow here is a snippet I am sure you can run with this.

    DoCmd.CopyDatabaseFile strDbName, True, True
    DBEngine.CompactDatabase strDbName, strTempDB

[ChaseCox]

I tried this snippet before. But it can only be used on a DB you are not currently in. I need someway to compact on closing. Any thoughts on this? I will keep looking for compact on close.

[Denburt]

O.K. I use VBA to create a VBS script and call it for updating my clients Front Ends the following code should help you accomplish what you need. Note this was stripped out of my DB so some of it may not be needed.

Option Compare Database
Option Explicit
Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
Public Const WIN_NORMAL = 1         'Open Normal
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&


Sub CompactSub()
'Define strPath and strFName and declare all variables

RunIt strPath, strFName
DeleteIt strFName
DoEvents
DBEngine.Idle
Application.Quit
End Function
Sub RunIt(strPath As String, strFName As String)
Dim varRet
varRet = fHandleFile(strPath & strFName, WIN_NORMAL)
End Sub
Function DeleteIt(strFile)
Dim FSO, strErr As String
Set FSO = CreateObject("Scripting.FileSystemObject")
strErr = FSO.DeleteFile(strFile)
'If strErr > 0 Then
' WS.PopUp strErr, 3
'End If
Set FSO = Nothing
End Function

Function fHandleFile(stFile As String, lShowHow As Long)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
End Function

[ChaseCox]

Thanks I will look at this and see if I can not get it to work for me. If I do, I will post what I used.

[Denburt]

VBS Code again this was stripped out of a bunch of other code and other code was stripped from this so this is definately not a copy paste solution but should get you headed in the right direction. Remember though VBS does not handle errors well:

Sub CompactMe()
on error resume next 
    Set objAccess = WScript.CreateObject("Access.Application")
    Set objScript= WScript.CreateObject("Scripting.FileSystemObject")
	objScript.CopyFile strDBName , strDBName & "z", True
If Err.Number <> 0 Then 
    myD=Err.Number & "  " & Err.Description & vbcrlf & "Creating a copy of the Database: " & strDBName 
	WS.Popup myD, 3
	err.Clear
	WScript.Quit()
End If
	objAccess.DbEngine.CompactDatabase strDBName ,strTempDB
If Err.Number <> 0 Then 
    myD=Err.Number & "  " & Err.Description & vbcrlf & "Database Name:" & strDBName &  vbcrlf & "Temp Database for Compacting:" & strTempDB & vbcrlf & "line 174 Compacting the database subroutine."
	WS.Popup myD, 3
	err.Clear
	WScript.Quit()
End If	
If objScript.FileExists(strDBName) Then
	objScript.DeleteFile strDBName
End If 
	objScript.CopyFile strTempDB, strDBName, True
If Err.Number <> 0 Then 
    myD=Err.Number & "  " & Err.Description & vbcrlf & "Database Name:" & strDBName &  vbcrlf & "Temp Database for Compacting:" & strTempDB & vbcrlf & "line 174 Compacting the database subroutine."
	WS.Popup myD, 3
  EmailErr(Err.Number & "  " & Err.Description & vbcrlf & "Database Name:" & strDBName &  vbcrlf & "New Database after Compacting:" & strTempDB & vbcrlf & "line 181 Compacting the database subroutine.")
	err.Clear
	WScript.Quit()
End If	
	objScript.DeleteFile strTempDB
    Set objScript = Nothing
If Err.Number <> 0 Then 
    myD=Err.Number & "  " & Err.Description & vbcrlf & "Database Name:" & strDBName &  vbcrlf & "Temp Database for Compacting:" & strTempDB & vbcrlf & "line 174 Compacting the database subroutine."
	WS.Popup myD, 3
	WScript.Quit()
End If
myD="The second stage to this script is to make sure the tables are relinked!" & vbcrlf & vbcrlf & "Please be patient!"
WS.Popup myD, 3
dbs.close
objAccess.quit 2
set objAccess = Nothing  
Set dbs = nothing
Set wks = Nothing
set dao=nothing
If Err.Number <> 0 Then 
	WScript.Quit()
End If
End Sub

[ChaseCox]

strTempDb, and the other names, could you give me a break down of what those should be? I would really appreciate it.

[Denburt]

strDBName ,strTempDB

strDBName is your database name
strTempDB merely a temporary db which will be deleted using the script.

Path = GetPath
strTempDB = Path & "Comp0001.mde"
strDBName = Path & "MyMDE.mde"
Function GetPath
' Return path to the current script
path = WScript.ScriptFullName  ' script file name
GetPath = Left(path, InstrRev(path, "\"))
End Function

The above Function only works if it is in the same directory as the database.

[ChaseCox]

My version of access does not recognize WSscript. and what is this vbcrlf Thanks again

[Denburt]

Sorry the following should be in the VBS script:

Path = GetPath
'Temporary db to be deleted once Compact is complete
strTempDB = Path & "Comp0001.mde"
'Your .mdb or mde file name here
strDBName = Path & "MyMDE.mde"

Function GetPath
' Return path to the current script
path = WScript.ScriptFullName  ' script file name
GetPath = Left(path, InstrRev(path, "\"))
End Function

[ChaseCox]

I am not sure I know what that means.

[Denburt]

The following should be placed in a module in your DataBase:

http://www.thescripts.com/forum/post2482491-7.html

I use notepad for all my VBS stuff, When you save the file make sure the extension is somefile.vbs

Paste in the following and make your adjustments.
This should be at the top of the VBS script:

http://www.thescripts.com/forum/post2482534-11.html

Then this in the VBS script:

http://www.thescripts.com/forum/post2482509-9.html