Pages Menu
Categories Menu

Posted by on Sep 21, 2013 in Tutorials | 0 comments

Compact and Repair Access Databases by Searching Directories and Sub-Folders

Compact and Repair Access Databases by Searching Directories and Sub-Folders

At some point in time most programmers are faced with a task where they need to recursively search through filesystem folders and perform some sort of operation on matched files.  For VBA programmers in Access, this “operation” often involves the compaction and repair of .mdb and .accdb files in order to free up disk space on the filesystem.

Step 1 – The recursive function

Sub RecursiveFileSearch(ByVal targetFolder As String, ByRef objRegExp As Object, _
    ByRef matchedFiles As Collection, ByRef objFSO As Object)

    Dim objFolder As Object
    Dim objFile As Object
    Dim objSubFolders As Object

    'Get the folder object associated with the target directory
    Set objFolder = objFSO.GetFolder(targetFolder)

    'Loop through the files current folder
    For Each objFile In objFolder.Files
        If objRegExp.test(objFile) Then
            matchedFiles.Add (objFile)
        End If

    'Loop through the each of the sub folders recursively
    Set objSubFolders = objFolder.Subfolders
    For Each objSubfolder In objSubFolders
        RecursiveFileSearch objSubfolder, objRegExp, matchedFiles, objFSO

    'Garbage Collection
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objSubFolders = Nothing

End Sub


Step 2 – Recursive controller

Function FindPatternMatchedFiles(sPath As String) As Collection

    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Pattern = ".*\.(mdb|accdb)"
    objRegExp.IgnoreCase = True

    Dim colFiles As Collection
    Set colFiles = New Collection

    RecursiveFileSearch sPath, objRegExp, colFiles, objFSO

    'Garbage Collection
    Set objFSO = Nothing
    Set objRegExp = Nothing

    Set FindPatternMatchedFiles = colFiles

End Function


Step 3 – Database Compaction and Repair

Function RepairDatabase(strSource As String, strDestination As String) As Boolean

    On Error GoTo error_handler

    RepairDatabase = Application.CompactRepair( _
        SourceFile:=strSource, _
        DestinationFile:=strDestination, _
        LogFile:=False _

    If RepairDatabase = True Then
        'Delete the original file
        SetAttr strSource, vbNormal
        Kill strSource

        'Rename the compacted DB to the orignal DB name
        SetAttr strDestination, vbNormal
        Name strDestination As strSource


        If Len(Dir(strDestination)) <> 0 Then
            SetAttr strDestination, vbNormal
            Kill strDestination
        End If
    End If

    'Reset the error trap and exit the function.
    On Error GoTo 0
    Exit Function

    'Return False if an error occurs.
        RepairDatabase = False
        MsgBox Error

End Function


Step 4 – Loop though each database and call compaction and repair on it

This last code snippet calls several utility functions that were not included in this tutorial. Source code for these functions can be found in the article Parsing a File String Into Path, File Name, and Extension.

Sub CompactRepairController(sPath As String)

    Dim colFiles As Collection
    Set colFiles = FindPatternMatchedFiles(sPath)

    Dim sFolder As String
    Dim sFilenameNoExtension As String
    Dim sExtension As String
    Dim bSuccess As Boolean

    Dim sFilePath As Variant

    For Each sFilePath In colFiles
        sFolder = FolderFromPath(CStr(sFilePath))
        sExtension = FileExtensionFromPath(CStr(sFilePath))
        sFilenameNoExtension = FileNameNoExtensionFromPath(CStr(sFilePath))
        bSuccess = RepairDatabase(CStr(sFilePath), sFolder + sFilenameNoExtension + "_temp." + sExtension)

End Sub


Step 5 – Pass the root folder to the database compaction routine

Sub main()

    CompactRepairController ("C:\Path\To\RootFolder")

End Sub


Leave a Reply