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.