Access backup en restore

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

De grootste problemen doen zich voor op de volgende punten:

  • AutoIncrement-velden (AutoNummering)
  • Relaties

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:

  • Maak een relatie-tabel aan en vul deze met de waardes uit MSysRelationships
  • Maak een backup-database aan en copieer alle te backuppen objecten hiernaartoe (inclusief de aangemaakte relatie-tabel)
  • Verwijder de relatie-tabel weer

De restore-procedure gaat als volgt:

  • Copieer alle objecten uit de backup-database (hierin staat dus ook de relatie-tabel)
  • Maak de relaties aan (m.b.v. de relatie-tabel)
  • Verwijder de relatie-tabel

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.