Excel to repair Access database

[adder]

Not sure whether I should post this in the Access section, but here's what I need - creat a macro in excel to compact 2 Access dbs (Risk.mdb and Riskdata.mdb)

This is a daily task for me, for now I'm doing it mannually, open each database, and go Tools --> database utilities --> compact and repair database.

I've thought about using macro within each database - whenever opening the file it triggers repair automatically, however I don't want to do it every time I open the database, instead I wish to control the repair from a master excel file.

Thanks for your help in advance

 

[Ruddles]

Ah, my code only demonstrates the method - it's just a code snippet which needs to be wrapped up in some code to protect the file from code failure. Also it writes the compacted database back to a different filename, which is probably not what you want.

I'd advise you to keep the pre-compacted file safe & sound until you know the post-compacted version works okay, if your system doesn't already do so.

 

[xenou]

And delete them when they're a month (or whatever period) old.

I'm not asking you to code this, just suggesting a method of keeping the backups under control.

Okay, here's a question. I suspect if you move or copy the file to a backup folder, it will have the create date and accessed date of the file as it existed when moved, not the date and time of the copy/move itself. So, in other words, if the file has an access date of one month ago, even if we move it today it will still have an access date of one month ago.

In *nix world I would "touch" the file. How would you do this with Windows?

 

[Ruddles]

When I make working backups of files, I usually insert "_" & Format(Now(),"yyyymmdd") just before the final dot in the filename, so even if I open them again after creating them - which I quite often do when I realise I've just deleted something vital from the copy I'm working on - I always know when they were created.

 

[xenou]

Okay. Re-written to incorporate all the suggestions so far. Lightly tested (but looks pretty good for a basic compact and repair routine).

I added two more features: you can list more than one database to be compacted. Also the activity is recorded to a log file. For simplicity I have written this so that all backups are saved to one backup location, even if the databases are in different folders. Backups older than one month are deleted, based on the datestamp added to the backup file name. Any errors will result in the procedure being aborted and no further backup/repairs will occur - so we can be sure to close the Access application running the compacts. (I think this would also guard against runaway error logging - if somehow such an infinite loop could occur).

Note that I have been using such a compact routine for about a year without problems - seems like this is useful not only to get the compacts done but also to have a regular backup of your database. I'd run it after hours or early in the morning.

[COLOR="Navy"]Option Explicit[/COLOR]

[COLOR="Navy"]Sub[/COLOR] CompactACDB()
[COLOR="Navy"]Dim[/COLOR] FSO [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Dim[/COLOR] AC [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sBackupPath [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sDBPath [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sTempPath [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sTemp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] errMsg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] col [COLOR="Navy"]As[/COLOR] VBA.Collection
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

    [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]GoTo[/COLOR] ErrHandler:

    [COLOR="SeaGreen"]'//Create objects[/COLOR]
    [COLOR="Navy"]Set[/COLOR] FSO = CreateObject("Scripting.FileSystemObject")
    [COLOR="Navy"]Set[/COLOR] AC = CreateObject("Access.Application")
    [COLOR="Navy"]Set[/COLOR] col = [COLOR="Navy"]New[/COLOR] Collection
    
    [COLOR="SeaGreen"]'//A location of a single permanent backup folder[/COLOR]
    sBackupPath = "C:\Documents and Settings\All Users\Documents\DB_Backups"
    
    [COLOR="SeaGreen"]'---------------------------------------[/COLOR]
    [COLOR="SeaGreen"]'//DBs to compact and repair (1 or more)[/COLOR]
    col.Add "C:\myTemp\TestDB5.accdb"
    col.Add "C:\myTemp\TestDB6.accdb"
    [COLOR="SeaGreen"]'---------------------------------------[/COLOR]
    
    [COLOR="SeaGreen"]'//Iterate DB's to compact and repair each in turn[/COLOR]
    [COLOR="Navy"]For[/COLOR] i = 1 [COLOR="Navy"]To[/COLOR] col.Count
        
        sDBPath = col.Item(i)
        
        [COLOR="SeaGreen"]'//Get temp filename[/COLOR]
        [COLOR="Navy"]With[/COLOR] FSO
            sTempPath = .GetTempName
            sTempPath = Replace(sTempPath, "tmp", .GetExtensionName(sDBPath))
            sTempPath = .GetParentFolderName(sDBPath) & "\" & sTempPath
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
        
        [COLOR="SeaGreen"]'//Compact Database (compacts back into its original file location)[/COLOR]
        FSO.MoveFile sDBPath, sTempPath
        AC.DBEngine.CompactDatabase sTempPath, sDBPath
        
        [COLOR="SeaGreen"]'//If original file was renamed and failed to compact then restore it[/COLOR]
        [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] FSO.FileExists(sDBPath) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] FSO.FileExists(sTempPath) [COLOR="Navy"]Then[/COLOR]
                FSO.MoveFile sTempPath, sDBPath
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

        [COLOR="SeaGreen"]'//Move Temp File to Backup Folder[/COLOR]
        sTemp = sBackupPath & "\" & FSO.GetBaseName(sDBPath) & "_" & Format(Now, "yyyymmdd.hhnnss") & "." & FSO.GetExtensionName(sDBPath)
        FSO.MoveFile sTempPath, sTemp
                    
        [COLOR="SeaGreen"]'//Clean Up Backups older than 30 days[/COLOR]
        [COLOR="Navy"]Call[/COLOR] Backups_Delete(FSO, sBackupPath, sDBPath)
    
        [COLOR="SeaGreen"]'//Log activity (this log is in the backup folder)[/COLOR]
        [COLOR="Navy"]Call[/COLOR] Write_Log(FSO, sBackupPath, (Now & " [" & sDBPath & "] --> compacted."))
    
    [COLOR="Navy"]Next[/COLOR] i
    
My_Exit:
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
[COLOR="SeaGreen"]'//Close Access[/COLOR]
[COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] AC [COLOR="Navy"]Is[/COLOR] [COLOR="Navy"]Nothing[/COLOR] [COLOR="Navy"]Then[/COLOR]
    AC.Quit
    [COLOR="Navy"]Set[/COLOR] AC = [COLOR="Navy"]Nothing[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] errMsg = "" [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] FSO [COLOR="Navy"]Is[/COLOR] [COLOR="Navy"]Nothing[/COLOR] [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Set[/COLOR] FSO = CreateObject("Scripting.FileSystemObject")
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]Call[/COLOR] Write_Log(FSO, sBackupPath, errMsg)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]Set[/COLOR] FSO = [COLOR="Navy"]Nothing[/COLOR]
[COLOR="Navy"]Set[/COLOR] col = [COLOR="Navy"]Nothing[/COLOR]
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]

ErrHandler:
[COLOR="SeaGreen"]'//An error will result in an abort of all further compact and repair operations[/COLOR]
errMsg = "Error: " & Err.Number & ": " & Err.Description
[COLOR="Navy"]Resume[/COLOR] My_Exit

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Sub[/COLOR] Check_Backup_Folder(ByRef FSO [COLOR="Navy"]As[/COLOR] Object, [COLOR="Navy"]ByRef[/COLOR] sDBPath [COLOR="Navy"]As[/COLOR] String)
[COLOR="SeaGreen"]'//To make sure a subfolder called "DB_Backups" exists in the same folder as the database to be compacted[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sTemp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]

    [COLOR="Navy"]With[/COLOR] FSO
        sTemp = .GetParentFolderName(sDBPath) & "\DB_Backups"
        [COLOR="Navy"]If[/COLOR] [COLOR="Navy"]Not[/COLOR] .FolderExists(sTemp) [COLOR="Navy"]Then[/COLOR]
            .CreateFolder (sTemp)
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Sub[/COLOR] Backups_Delete(ByRef FSO [COLOR="Navy"]As[/COLOR] Object, _
    [COLOR="Navy"]ByRef[/COLOR] sBackupPath [COLOR="Navy"]As[/COLOR] String, [COLOR="Navy"]ByRef[/COLOR] sDBPath [COLOR="Navy"]As[/COLOR] String)
[COLOR="SeaGreen"]'//To delete backups older than 30 days[/COLOR]
[COLOR="SeaGreen"]'//Assumes that DB backups are saved in the form DBName_yyyymmdd.mdb or DBName_yyyymmdd.hhnnss.mdb[/COLOR]

[COLOR="Navy"]Dim[/COLOR] re [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Dim[/COLOR] fldr [COLOR="Navy"]As[/COLOR] Folder
[COLOR="Navy"]Dim[/COLOR] f [COLOR="Navy"]As[/COLOR] File
[COLOR="Navy"]Dim[/COLOR] s [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] d [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Date[/COLOR]
    
    [COLOR="Navy"]Set[/COLOR] re = CreateObject("VBScript.RegExp")
    [COLOR="Navy"]With[/COLOR] re
        .Pattern = FSO.GetBaseName(sDBPath)
        .Pattern = .Pattern & "_\d{8}"
        .Global = False
        .MultiLine = False
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]

    [COLOR="Navy"]With[/COLOR] FSO
        [COLOR="Navy"]Set[/COLOR] fldr = .GetFolder(sBackupPath)
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] f [COLOR="Navy"]In[/COLOR] fldr.Files
            [COLOR="Navy"]If[/COLOR] re.Test(f.Name) [COLOR="Navy"]Then[/COLOR]
                s = re.Execute(f.Name)(0)
                d = DateSerial(Left(Right(s, 8), 4), Left(Right(s, 4), 2), Right(s, 2))
                [COLOR="Navy"]If[/COLOR] d < (Date - 30) [COLOR="Navy"]Then[/COLOR]
                    f.Delete
                [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
            [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
        [COLOR="Navy"]Next[/COLOR] f
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
    
    [COLOR="Navy"]Set[/COLOR] re = [COLOR="Navy"]Nothing[/COLOR]
    
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="SeaGreen"]'_______________________[/COLOR]
[COLOR="Navy"]Sub[/COLOR] Write_Log(ByRef FSO [COLOR="Navy"]As[/COLOR] Object, [COLOR="Navy"]ByRef[/COLOR] sBackupPath [COLOR="Navy"]As[/COLOR] String, [COLOR="Navy"]ByRef[/COLOR] arg [COLOR="Navy"]As[/COLOR] String)
[COLOR="SeaGreen"]'//Records compact/repair activity and any errors[/COLOR]
[COLOR="SeaGreen"]'//Log file is assumed to be in the permanent backup folder with the backups and will be created if missing[/COLOR]
[COLOR="SeaGreen"]'//Self deletes if it grows to 8Mb in size[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sTemp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] f [COLOR="Navy"]As[/COLOR] File
[COLOR="Navy"]Dim[/COLOR] ts [COLOR="Navy"]As[/COLOR] TextStream

    [COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
    sTemp = sBackupPath & "\" & "log.txt"
    [COLOR="Navy"]Set[/COLOR] ts = FSO.OpenTextFile(sTemp, 8, True, -2)
    ts.WriteLine arg
    ts.Close
    [COLOR="Navy"]Set[/COLOR] ts = [COLOR="Navy"]Nothing[/COLOR]
    
    [COLOR="Navy"]Set[/COLOR] f = FSO.GetFile(sTemp)
    [COLOR="Navy"]If[/COLOR] f.Size > 8000000 [COLOR="Navy"]Then[/COLOR] [COLOR="SeaGreen"]'//Log file has been ignored for ages.  Delete it.[/COLOR]
        f.Delete
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]Set[/COLOR] f = [COLOR="Navy"]Nothing[/COLOR]
    
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]