Compact/repair access database from excel

[krice1974]

Hi all. I have an access database that is updated with vba that runs in excel every day. It's sizeable. I need to compact it after every daily data "run." I run the two procedures back to back from excel. The first runs access macros. It might not have any real impact on what I'm trying to do, but I think it might since it uses an instance of the same database, just before the compact and repair procedure. All of this runs just fine without error, but the database doesn't compact. I have to do it manually every morning. Any suggestions? Here's the two macros that act on the access file from excel:

Sub AccessMacros()
'Execute the different append queries on the database to add the latest data to the
'points of interest table. Works by calling the access macro. We do it this way, instead
'of with excel code, since the excel/ access vba doesn't recognize udfs.
Dim strPath As String
Dim appAccess As Access.Application
 
    strPath = "C:\Documents and Settings\User\Desktop\Business\Investments\TradeSystem\TradeSystem.accdb"
    Set appAccess = New Access.Application
    'Set appAccess = GetObject(strPath)
 
    With appAccess
        Application.DisplayAlerts = False
        .OpenCurrentDatabase strPath
        .DoCmd.RunMacro "macDeleteNewSymbolsTableRecords"
        .DoCmd.RunMacro "macDeleteDups"
        .DoCmd.RunMacro "macAppendToArchivesThenDeleteOldPricingVolData"
        .DoCmd.RunMacro "macInactiveSymbsArchiveAndDeleteData"
        .DoCmd.RunMacro "macDailyFunctionsUpdateTable"
        Application.DisplayAlerts = True
        .Quit
    End With
 
    Set appAccess = Nothing
 
   End Sub
 
Sub CloseAndCompactDatabase()
'Opens and closes the access database to compact it.
Dim strPath As String
Dim appAccess As Access.Application
 
    'Make sure alerts are turned off. We need this since without, there is a timeout error.
    If Application.DisplayAlerts = True Then
        Application.DisplayAlerts = False
    End If
 
    'Write the string for the file path.
    strPath = "C:\Documents and Settings\User\Desktop\Business\Investments\TradeSystem\TradeSystem.accdb"
 
    'Set the application object to the database. It seems to compact it upon opening.
    Set appAccess = GetObject(strPath)
 
    'Close the database.
    With appAccess
        .CloseCurrentDatabase
    End With
 
    'Turn alerts back on.
    If Application.DisplayAlerts = False Then
        Application.DisplayAlerts = True
    End If
 
    'Destroy the application object.
    'Set appAccess = Nothing
 
End Sub

 

[tinkythomas]

Hi,

Have you set the db to compact and repair on close? Depending on which version of access your using this can be set under access options.

For 2003 go to Tools>Options>General>Compact on Close. For 2007 click the Office button>Access Options>Current Database>Compact on Close. For earlier versions I'm not sure as I have never used them.

However if you want to compact using code then the following command should do it...

DoCmd.RunCommand acCmdCompactDatabase

Hope that helps

 

[krice1974]

Hi Thomas, thanks for the response. I do have it set to compact on close. I tried your command, and access generates the message that it cannot compact an open database (remember, code is running from excel). I replaced your line with:

DoCmd.RunCommand acCmdCloseDatabase

and that did the trick when I step through it, but not during the normal execution that night unfortunately, which is what I had encountered before. Still stuck...

 

[SydneyGeek]

It's nasty but it should work...

Sendkeys "%TDC"

Denis
</pre>

 

[krice1974]

Denis, I missed your response from a couple weeks back. Sorry. Thanks, I'm trying to implement it now...

 

[sacidk]

This code works, found it this link : http://www.vbaexpress.com/forum/showthread.php?9262-Solved-VBA-Compact-and-Repair and modified a little bit;

<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Sub CompactAndRepairAccessDB()

Dim Acc As Object
Set Acc = CreateObject("access.application")

Dim dbPath As String, dbPathX As String
dbPath = Application.ThisWorkbook.Path & "" & "YourDatabaseNameHere.accdb"
dbPathX = Application.ThisWorkbook.Path & "\" & "tmp.accdb"

Acc.DBEngine.CompactDatabase dbPath, dbPathX
Acc.Quit
Set Acc = Nothing
Kill dbPath
Name dbPathX As dbPath

End Sub

</code>