Backup en Restore in MS-Access


Wanneer u een mooi project in Access bouwt, dan heeft u vast de behoefte aan een backup- en restore-fasciliteit. Nu is het in Access niet zo moeilijk om tabellen en queries te exporteren of te copieren naar een andere database, maar de problemen beginnen pas bij het restoren.

De grootste problemen doen zich voor op de volgende punten:

Het zo maar terugzetten van een waarde in een veld van het type AutoNummering levert meteen een probleem op. Dit is op zich niet zo erg tenzij zo'n veld deel uitmaakt van een relatie.

De relaties tussen tabellen worden in Access bijgehouden in de systeem-tabel MSysRelationships. Het vervelende is echter dat deze tabel niet zomaar te bewerken valt, alleen raadplegen is toegestaan.

We zullen dus voor al deze problemen een oplossing moeten vinden.

Ik heb dat reeds gedaan en wil hier graag deze kennis met u delen. Ik ga er hierbij vanuit dat u (een beetje) weet hoe VBA werkt en dat u een module in Access kunt toevoegen.

De backup-procedure gaat als volgt:

De restore-procedure gaat als volgt:

De backup-procedure is redelijk straight-foreward.

Bij de restore-procedure moet rekening worden gehouden met het feit dat Access bestaande objecten niet vanzelf zal overschrijven bij een import; hier moeten we dus zelf voor zorgen.

Hieronder zal ik nu de procedures en functies stuk voor stuk geven met daar waar nodig een stukje uitleg. Tezamen vormen ze een module die u in Access kunt gebruiken.

Vooraf dient u nog het volgende te weten:

Alle objecten laat ik bij de naamgeving vooraf gaan door een prefix. Hiervan maak ik in de code gebruik.

Object Prefix
Tabellen tbl
Queries qry
Formulieren frm
Rapporten rpt
Pagina's pag
Macro's mac
Modules mod

Hieronder staan de functies en procedures:


Function FileExists(ByVal FileName As String) As Boolean
    FileExists = (Dir(FileName, vbNormal) <> "")
End Function

Deze functie kijkt of de opgegeven bestandsnaam (FileName) bestaat; zo ja dan wordt de functie True, zo nee, dan wordt de functie False. In de FileName mag ook een schijf en/of pad voorkomen.


Function BestaatObject(ByVal ObjectNaam As String) As Boolean
    Dim rs As DAO.Recordset
   
    Set rs = CurrentDb.OpenRecordset("SELECT COUNT(*) FROM MSysObjects WHERE Name = '" & ObjectNaam & "'", dbOpenSnapshot)
    BestaatObject = (rs.Fields(0).Value > 0)
    rs.Close
    Set rs = Nothing
End Function

Deze functie kijkt of een (Access-) object in de huidige access-applicatie voorkomt. Zo ja dan wordt de functie True, zo nee, dan wordt de functie False.


Sub DropTabel(ByVal tn As String)
    DBEngine(0)(0).TableDefs.Refresh
    If BestaatObject(tn) Then
        DBEngine(0)(0).TableDefs.Delete tn
        Application.RefreshDatabaseWindow
    End If
End Sub

Deze procedure haalt de tabel met naam tn weg, als deze bestaat. Tabellen staan in de systeem-collectie TableDefs.


Sub DropQuery(ByVal qn As String)
    DBEngine(0)(0).QueryDefs.Refresh
    If BestaatObject(qn) Then
        DBEngine(0)(0).QueryDefs.Delete qn
        Application.RefreshDatabaseWindow
    End If
End Sub

Deze procedure haalt de query met de naam qn weg, als deze bestaat. Queries staan in de systeem-collectie QueryDefs.


Sub DropRapport(ByVal rn As String)
    If BestaatObject(rn) Then
        DoCmd.DeleteObject acReport, rn
    End If
End Sub

Deze procedure haalt het rapport met de naam rn weg, als deze bestaat.


Sub VerwijderRelatie(ByVal relname As String)
    DBEngine(0)(0).Relations.Refresh
    If BestaatObject(relname) Then
        DBEngine(0)(0).Relations.Delete relname
    End If
End Sub

Deze procedure haalt de relatie met de naam relname weg, als deze bestaat. Relaties staan in de systeem-collectie Relations.

De constructie DBEngine(0)(0) is equivalent met CurrentDb.
Met de opdracht Application.RefreshDatabaseWindow wordt het database-venster ververst.


Sub MaakRelatieTabel()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim ind As DAO.Index
    Dim rs(1 To 2) As DAO.Recordset
    Dim i As Integer
   
    If BestaatObject("tblRelationShips") Then
        DropTabel "tblRelationShips"
    End If
    'maken van tabel tblRelationShips:
    Set db = CurrentDb()
    Set tdf = db.CreateTableDef("tblRelationShips") 'hiermee wordt een tabel-definitie gestart
   
    With tdf
        Set fld = .CreateField("RelationID", dbLong) 'maak een veld van type Long aan
        fld.Attributes = dbAutoIncrField + dbFixedField 'maak het veld AutoNummering
        .Fields.Append fld 'voeg veld toe aan tabel-definitie
        .Fields.Append .CreateField("rel_naam", dbText, 255) 'maak tekst-veld (lengte 255) en voeg toe aan tabel-definitie
        .Fields.Append .CreateField("rel_ref_obj", dbText, 255)
        .Fields.Append .CreateField("rel_ref_fld", dbText, 255)
        .Fields.Append .CreateField("rel_obj", dbText, 255)
        .Fields.Append .CreateField("rel_fld", dbText, 255)
        .Fields.Append .CreateField("rel_attr", dbLong)
        .Fields.Append .CreateField("rel_ccol", dbLong)
        .Fields.Append .CreateField("rel_icol", dbLong)
    End With
   
    db.TableDefs.Append tdf 'voeg de tabel-definitie toe aan de database
    Set fld = Nothing 'maak object-variabele leeg
    Set tdf = Nothing
    'maken van een sleutel-veld:
    Set tdf = db.TableDefs("tblRelationShips") 'maak contact met de tabel tblRelationShips
   
    Set ind = tdf.CreateIndex("PrimaryKey") 'start de index-definitie
    With ind
        .Fields.Append .CreateField("RelationID") 'voeg een index op het veld RelationID toe
        .Unique = False
        .Primary = True 'het sleutel-veld
    End With
    tdf.Indexes.Append ind 'voeg de index toe aan de database
    tdf.Indexes.Refresh
    Set ind = Nothing
    Set tdf = Nothing
    Set db = Nothing
    Application.RefreshDatabaseWindow
    'vullen van de nieuwe tabel:
    Set rs(1) = CurrentDb.OpenRecordset("SELECT szRelationship, szReferencedObject, szReferencedColumn, szObject, szColumn, grbit, ccolumn, icolumn FROM MSysRelationships ", dbOpenSnapshot) 'maak een record-set om te lezen
    If Not rs(1).EOF Then 'als record-set niet leeg is dan
        Set rs(2) = CurrentDb.OpenRecordset("tblRelationShips", dbOpenDynaset) 'maak contact met tabel om te muteren
        rs(1).MoveFirst 'ga naar het eerste record
        Do While Not rs(1).EOF 'zolang er nog records zijn
            rs(2).AddNew 'voeg een nieuw record toe
            For i = 0 To 7
                rs(2).Fields(i + 1).Value = rs(1).Fields(i).Value 'vul de overeenkomstige velden
            Next i
            rs(2).Update 'bewaar het gevulde record
            rs(1).MoveNext 'ga naar het volgende record
        Loop
        rs(2).Close 'sluit record-set/tabel
        Set rs(2) = Nothing
    End If
    rs(1).Close
    Set rs(1) = Nothing
End Sub

Deze procedure maakt een relatie-tabel aan en vult deze met de huidige relaties.


Sub DropRelatieTabel()
    DropTabel "tblRelationShips"
End Sub

Deze procedure gooit de relatie-tabel weg.


Sub MaakRelaties()
    Dim db As DAO.Database
    Dim rel As DAO.Relation
    Dim fld As DAO.Field
    Dim rs As DAO.Recordset
   
    If BestaatObject("tblRelationShips") Then
       
        Set db = CurrentDb()
       
        Set rs = db.OpenRecordset("tblRelationShips", dbOpenSnapshot)
        If Not rs.EOF Then
            rs.MoveFirst
           
            Do While Not rs.EOF
           
                Set rel = db.CreateRelation(rs.Fields("rel_naam").Value) 'geef relatie een naam
               
                With rel
                    .Table = rs.Fields("rel_ref_obj").Value 'wat is de originele tabel (de 1-kant)
                    .ForeignTable = rs.Fields("rel_obj").Value 'wat is de beeld-tabel (de n-kant)
                    .Attributes = rs.Fields("rel_attr").Value  'wat zijn de attributen van de relatie (integriteit, cascading deletion/update etc.)
                    Set fld = .CreateField(rs.Fields("rel_ref_fld").Value) 'wat is het sleutel-veld (aan de 1-kant)
                    fld.ForeignName = rs.Fields("rel_fld").Value 'wat is de vreemde-sleutel (aan de n-kant)
                    .Fields.Append fld
                End With
                db.Relations.Append rel 'voeg de relatie toe aan de database
                Set fld = Nothing
                Set rel = Nothing
               
                rs.MoveNext
            Loop
        End If
        rs.Close
        Set rs = Nothing
        Set db = Nothing
    End If
End Sub

Deze procedure maakt de relaties aan.


Sub BackUpObjecten()
    Dim dbname As String
    Dim ws As Workspace
    Dim db As Database
    Dim rs As DAO.Recordset
    Dim rapporten() As String
    Dim queries() As String
    Dim tabellen() As String
    Dim prfx As String
    Dim t As Integer
    Dim SQL As String
    'inventariseer welke objecten in aanmerking komen om naar de backup te gaan:
    ReDim rapporten(0 To 0)

    ReDim queries(0 To 0)
    ReDim tabellen(0 To 0)
    SQL = "SELECT Name FROM MSysObjects WHERE Type <> 8" 'in MSysObjects staan alle Access-objecten; Type=8 duidt op een relatie-naam
    Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
    If Not rs.EOF Then
        rs.MoveFirst
        Do While Not rs.EOF
            prfx = UCase(Left(rs.Fields(0).Value, 3)) 'bepaal de prefix van het object                            
            If prfx = "QRY" Then
                ReDim Preserve queries(0 To UBound(queries) + 1)
                queries(UBound(queries)) = rs.Fields(0).Value
            End If
            If prfx = "RPT" Then
                ReDim Preserve rapporten(0 To UBound(rapporten) + 1)
                rapporten(UBound(rapporten)) = rs.Fields(0).Value
            End If
            If prfx = "TBL" Then
                ReDim Preserve tabellen(0 To UBound(tabellen) + 1)
                tabellen(UBound(tabellen)) = rs.Fields(0).Value
            End If                           
            rs.MoveNext
        Loop
    End If
    rs.Close
    Set rs = Nothing
   
    dbname = Application.CurrentProject.Path & "\backupdb.bak.mdb" 'maak backup-databasse aan (bestand)
    If FileExists(dbname) Then 'als backup-database al bestaat dan
        Kill dbname 'delete het
    End If
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.CreateDatabase(dbname, dbLangGeneral) 'creëer backup-database (inhoudelijk)
    db.Close
    Set db = Nothing
    ws.Close
    Set ws = Nothing
    For t = 1 To UBound(rapporten)
        DoCmd.CopyObject dbname, rapporten(t), acReport, rapporten(t) 'copieer alle rapporten naar de backup-database
    Next t
    For t = 1 To UBound(queries)
        DoCmd.CopyObject dbname, queries(t), acQuery, queries(t) 'copieer alle queries naar de backup-database
    Next t
    For t = 1 To UBound(tabellen)
        DoCmd.CopyObject dbname, tabellen(t), acTable, tabellen(t) 'copieer alle tabellen naar de backup-database
    Next t
    MsgBox "De backup is gemaakt onder de naam: " & dbname, vbOKOnly + vbInformation, "BACKUP KLAAR"
End Sub

Deze procedure maakt een backup-database aan en copieert daarna alle tabellen (tbl...), alle queries (qry...) en alle rapporten (rpt...) van de huidige Access-applicatie naar de backup-database.


Sub VerwijderRelaties()
    Dim rs As DAO.Recordset
    Dim SQL As String
    Dim relname() As String
    Dim i As Integer, a As Integer
   
    a = 0
    SQL = "SELECT szRelationship FROM MSysRelationships WHERE LEFT(UCASE(szRelationship),3) = 'TBL'"
    Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
    If Not rs.EOF Then
        ReDim relname(1 To 1)
        a = 1
        rs.MoveFirst
        Do While Not rs.EOF
            relname(UBound(relname)) = rs.Fields(0).Value
            rs.MoveNext
            If Not rs.EOF Then
                ReDim Preserve relname(1 To UBound(relname) + 1)
            End If
        Loop
    End If
    rs.Close
    Set rs = Nothing
    If a > 0 Then
        For i = 1 To UBound(relname)
            VerwijderRelatie relname(i)
        Next i
    End If
End Sub

Deze procedure verwijdert alle huidige relaties.


Sub RestoreObjecten()
    Dim rs As DAO.Recordset
    Dim db As DAO.Database
    Dim dbname As String
    Dim SQL As String
    Dim prfx As String
    Dim doc As String
    Dim import As Boolean
   
    dbname = Application.CurrentProject.Path & "\backupdb.bak.mdb"
    If FileExists(dbname) Then 'als de backup-database is gevonden
        VerwijderRelaties
        Set db = DBEngine.Workspaces(0).OpenDatabase(dbname) 'maak contact met de backup-database
        SQL = "SELECT Name FROM MSysObjects WHERE Type <> 8"
        Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
        If Not rs.EOF Then
            rs.MoveFirst
            Do While Not rs.EOF
                doc = rs.Fields(0).Value 'naam van het object
                prfx = UCase(Left(doc, 3)) 'bepaal prefix
                Select Case prfx
                    Case "TBL"
                        If BestaatObject(doc) Then 'als tabel in de huidige database al bestaat
                            DropTabel doc
                        End If
                        DoCmd.TransferDatabase acImport, "Microsoft Access", dbname, acTable, doc, doc, False 'importeer de tabel
                    Case "QRY"
                        If BestaatObject(doc) Then
                            DropQuery doc
                        End If
                        DoCmd.TransferDatabase acImport, "Microsoft Access", dbname, acQuery, doc, doc, False
                    Case "RPT"
                        If BestaatObject(doc) Then
                            DropRapport doc
                        End If
                        DoCmd.TransferDatabase acImport, "Microsoft Access", dbname, acReport, doc, doc, False
                End Select
                rs.MoveNext
            Loop
        End If
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        MsgBox "De import/restore is klaar!", vbOKOnly, "KLAAR"
    Else
        MsgBox "Backup-bestand niet gevonden!", vbOKOnly + vbInformation, "KLAAR"
    End If
End Sub

Deze procedure importeert de objecten (tabellen, queries en rapporten) uit de backup-database. Als een object al in de huidige database bestaat wordt deze eerst verwijderd.


Sub Backup()
    MaakRelatieTabel
    BackUpObjecten
    DropRelatieTabel
End Sub

Deze procedure maakt een backup zoals in het begin van dit hoofdstuk staat beschreven.


Sub Restore()
    RestoreObjecten
    MaakRelaties
    DropRelatieTabel
End Sub

Deze procedure maakt een restore zoals  in het begin van dit hoofdstuk staat beschreven.



Wanneer u alle bovenstaande procedures en functies in een module zet, dan heeft u een aardige tool om te backuppen en te restoren.

Bij het backuppen en restoren wordt er onderscheid gemaakt in de objecten door middel van een prefix. Dit is gewoon een handigheidje, omdat ik nu eenmaal lijdt aan beroepsdeformatie en alle objecten in de computer-wereld vooraf laat gaan door een prefix.

Het is natuurlijk ook mogelijk om onderscheid tussen de verschillende objecten te maken door te kijken naar het veld Type in de systeem-tabel MSysObjects. Hieronder een overzicht van de verschillende waardes voor Type per object:

Object Type-waarde
Tabellen 1
Queries 5
Formulieren -32768
Rapporten -32764
Pagina's -32756
Macro's -32766
Modules -32761


Als laatste is het belangrijk dat wanneer u een module maakt met de bovenstaande procedures en functies dat u in de VBA-editor een verwijzing legt naar de "DAO object library"; kies in de module de optie "Verwijzingen..." uit het menu "Extra" en zoek naar "Microsoft DAO ..." en zet hier een vinkje voor.

U kunt hier de gehele module downloaden.

Ik hoop dat deze informatie nuttig voor u is, en dat u heeft gevonden wat u zocht.