Compact & Repair in Access 2010 - vba not working

[loopa1]

Hi all, I have the following code which is executed when the user chooses to close the database by clicking on the exit botton...

Private Sub Command3_Click()
Dim AccessVer As Integer

On Error GoTo Err_Command3_Click

DoCmd.RunMacro "Delete all Table Information"
AccessVer = SysCmd(acSysCmdAccessVer)

If AccessVer < 12 Then
    CommandBars("Menu Bar").Controls("Tools").Controls("Database utilities").Controls("Compact and repair database...").accDoDefaultAction
    DoCmd.Quit
Else
    If SysCmd(acSysCmdAccessVer) = 12 Then
        SendKeys "%(FMC)", False
    Else
        SendKeys "%(YC)", False
    End If
    DoCmd.Quit
End If

Exit_Command3_Click:
    Exit Sub

Err_Command3_Click:
    MsgBox Err.Description
    Resume Exit_Command3_Click
    
End Sub

As you can see, I've adapted it so that it should compact and repair regardless of Access version, however, it's not compacting the database in Access 2010 - why not? The code recognises that it's Access 2010, and therefore executes [SendKeys "%(YC)", False], but nothing happens...the database just goes on to close (which is correct). However, if I manually click the compact and repair button, it works!

Help please!

 

[mdmilner]

There's kinda a goofy suggestion in here to create a temporary database (close current, run temporary it calls the DAO based Compact and then re-opens original).

http://social.msdn.microsoft.com/Forums/en-US/accessdev/thread/5b223ce5-6119-452d-9e11-f7d4111460b9/

I kinda liked the idea of splitting the database which gives you the opportunity to compact the backend.

I've wrote and setup a .Net (baby) app that compacted the database for me (from the outside). Very basic stuff. Reviewing this, I embedded the paths in the code. There's no reason you couldn't use an INI file to give it an easily editable list to control what it does.

    Public Function CompactAccess(ByVal strDB As String, ByVal strDBc As String) As Boolean
        Dim Engine As DAO.DBEngine
        CompactAccess = True
        Engine = CreateObject("DAO.DBEngine.36")
        Call Engine.CompactDatabase(strDB, strDBc)
        sSleep(1000)
        Console.WriteLine("Compaction Complete" & strDB)
        sSleep(1000)
        Call FileCopy(strDBc, strDB)
        sSleep(1000)
        Kill(strDBc)
        Console.WriteLine("Compact Copy Deleted" & strDBc)
        sSleep(1000)

    End Function

 

[HiTechCoach]

WARNING: Make a back up before compacting

WOW. You really like living on the edge.

WARNING: Make a back up before compacting

It is very critical that you make a backup before you compact any database. Compacting can destory a database beyond repair.

WARNING: Make a back up before compacting

Note: This only works for single user database that are never shared.. Multi user databases (really ever database) should be split. This will only compact the front end. Not the back end.

WARNING: Make a back up before compacting


HINT: Don't forget to back up before compacting.

 

[mdmilner]

interesting

Yep, you're enthusiastic. Sounds like a great idea to me.
Keep this in mind, this is not VBA...it's a standalone mini-app.

This makes generational (aka, dated) copies using .Net 1.0 accessing a

Module Module1

    Sub Main()
        Dim strBuffer As String
        Dim strSource As String
        Dim strMode As String = "None"
        Dim strDestination() As String
        Dim lngCnt As Long = 0
        Dim x As Long

        ' note, malformed urls will fail
        ' function supports multiple destinations for each source file
        ' additional files to copy (to respective destination) are possible
        ' [Perform Backup] is the command that initiates the process to begin
        Dim sReader As New IO.StreamReader(New IO.FileStream("C:\check.ini", IO.FileMode.Open))

        While Not sReader.Peek() = -1
            strBuffer = sReader.ReadLine
            Select Case strBuffer
                Case "[Database Source]"
                    strMode = "Source"
                Case "[Database Destination]"
                    strMode = "Destination"
                Case "[Perform Backup]" 'has no data, just does it
                    If strMode = "Destination" Then
                        For x = 1 To lngCnt
                            CopyDatabase(strSource, strDestination(x))
                        Next
                    End If
                    lngCnt = 0 'reset
                    strSource = "" 'reset
                    strDestination(0) = "" 'reset
                    strMode = "Pending" 'after it's copied information
                Case Else
                    If strMode = "Source" Then
                        strSource = strBuffer
                    End If
                    If strMode = "Destination" Then
                        lngCnt = lngCnt + 1
                        ReDim Preserve strDestination(lngCnt)
                        strDestination(lngCnt) = strBuffer
                    End If
            End Select
        End While
        sReader.Close()

        sReader = Nothing
    End Sub

    Function CopyDatabase(ByVal strSrc As String, _
                     ByVal strDest As String) As Boolean
        Dim strVal As String

        strDest = AddDate(strDest)
        Try
            Console.WriteLine("Copying " & strSrc & " to " & strDest)
            sSleep(2000)
            FileCopy(strSrc, strDest)
            Console.WriteLine("Copied " & strSrc & " to " & strDest)
            Console.WriteLine(" ")
            sSleep(2000)
        Catch
            strVal = strSrc
            If ValidateFile(strVal) Then
                MsgBox(strVal & " Is an invalid location")
                CopyDatabase = False
                Exit Function
            End If
        End Try
    End Function

    Function AddDate(ByVal strVal As String) As String
        Dim pos, sLen As Long
        Dim strDate As String = DateString()
        pos = InStr(strVal, ".mdb")
        If pos > 0 Then
            AddDate = Left(strVal, pos - 1) & "_" & DateString() & Right(strVal, 4)
        Else
            AddDate = strVal
        End If
    End Function
    Function ValidateFile(ByVal strPath As String) As Boolean
        Dim lngType As Long = 0
        ValidateFile = Len(Dir(strPath, lngType)) > 0
    End Function

    Private Declare Sub sapiSleep Lib "kernel32" _
        Alias "Sleep" _
        (ByVal dwMilliseconds As Long)

    Sub sSleep(ByVal lngMilliSec As Long)
        If lngMilliSec > 0 Then
            Call sapiSleep(lngMilliSec)
        End If
    End Sub
End Module

Check.ini just looks like:
[/code]
[Database Source]
D:\aaa\bbb.mdb
[Database Destination]
D:\aaa\ccc\bab.mdb
additional destinations as needed
[Make Backup]
[/code]

It's set to make as many copies to different destinations as you might want. You could also continue to layer in multiple sources by adding a new [Database Source] segment.

This was a quick way that didn't need to use the registry to use the Windows scheduler utility to regularly copy the full database...and then to trigger a completely separate process of compacting the production database. Because I copied to completely different drives, it gave me a worst case recovery option if the DB got corrupted of losing a day's worth of processing.

What I liked the most from this is it bypassed a lot of quirks from running the routines INSIDE access and gave me a baby version of what you'd get in a real datacenter on a machine I used as a development platform sitting beside me in my office without doing it manually. There's nothing really complex with this...just basic programming.

 

[HiTechCoach]

mdmilner, great solution. I think using .NET is a good idea. Thanks for sharing the code.

I also like to compact from one database to another. This allows the original to be saved.

Yeah ... I get a little crazy ( maybe OCD ) about backups. I am just amazed at how few people actual do regular backups.