\n| Modules<\/td>\n | mod<\/td>\n<\/tr>\n<\/tbody>\n<\/table>\n Hieronder staan de functies en procedures:<\/p>\n
\nFunction FileExists(ByVal FileName As String) As Boolean<\/span>
\n\u00a0 FileExists = (Dir(FileName, vbNormal) <> “”)<\/span>
\nEnd Function<\/span><\/p>\nDeze 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.<\/p>\n
\nFunction BestaatObject(ByVal ObjectNaam As String) As Boolean<\/span>
\n\u00a0 Dim rs As DAO.Recordset<\/span><\/p>\n\u00a0 Set rs = CurrentDb.OpenRecordset(“SELECT COUNT(*) FROM MSysObjects WHERE Name = ‘” & ObjectNaam & “‘”, dbOpenSnapshot)<\/span>
\n\u00a0 BestaatObject = (rs.Fields(0).Value > 0)<\/span>
\n\u00a0 rs.Close<\/span>
\n\u00a0 Set rs = Nothing<\/span>
\nEnd Function<\/span><\/p>\nDeze 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.<\/p>\n
\nSub DropTabel(ByVal tn As String)<\/span>
\n\u00a0 DBEngine(0)(0).TableDefs.Refresh<\/span>
\n\u00a0 If BestaatObject(tn) Then<\/span>
\n\u00a0 \u00a0 DBEngine(0)(0).TableDefs.Delete tn<\/span>
\n\u00a0 \u00a0 Application.RefreshDatabaseWindow<\/span>
\n\u00a0 End If<\/span>
\nEnd Sub<\/span><\/p>\nDeze procedure haalt de tabel met naam tn weg, als deze bestaat. Tabellen staan in de systeem-collectie\u00a0TableDefs.<\/p>\n
\nSub DropQuery(ByVal qn As String)<\/span>
\n\u00a0 DBEngine(0)(0).QueryDefs.Refresh<\/span>
\n\u00a0 If BestaatObject(qn) Then<\/span>
\n\u00a0 \u00a0 DBEngine(0)(0).QueryDefs.Delete qn<\/span>
\n\u00a0 \u00a0 Application.RefreshDatabaseWindow<\/span>
\n\u00a0 End If<\/span>
\nEnd Sub<\/span><\/p>\nDeze procedure haalt de query met de naam qn weg, als deze bestaat. Queries staan in de systeem-collectie\u00a0QueryDefs.<\/p>\n
\nSub DropRapport(ByVal rn As String)<\/span>
\n\u00a0 If BestaatObject(rn) Then<\/span>
\n\u00a0 \u00a0 DoCmd.DeleteObject acReport, rn<\/span>
\n\u00a0 End If<\/span>
\nEnd Sub<\/span><\/p>\nDeze procedure haalt het rapport met de naam rn weg, als deze bestaat.<\/p>\n
\nSub VerwijderRelatie(ByVal relname As String)<\/span>
\n\u00a0 DBEngine(0)(0).Relations.Refresh<\/span>
\n\u00a0 If BestaatObject(relname) Then<\/span>
\n\u00a0 \u00a0 DBEngine(0)(0).Relations.Delete relname<\/span>
\n\u00a0 End If<\/span>
\nEnd Sub<\/span><\/p>\nDeze procedure haalt de relatie met de naam relname weg, als deze bestaat. Relaties staan in de systeem-collectie\u00a0Relations.<\/p>\n De constructie\u00a0DBEngine(0)(0)\u00a0is equivalent met\u00a0CurrentDb.
\nMet de opdracht\u00a0Application.RefreshDatabaseWindow\u00a0wordt het database-venster ververst.<\/p>\n
\nSub MaakRelatieTabel()<\/span>
\n\u00a0 Dim db As DAO.Database<\/span>
\n\u00a0 Dim tdf As DAO.TableDef<\/span>
\n\u00a0 Dim fld As DAO.Field<\/span>
\n\u00a0 Dim ind As DAO.Index<\/span>
\n\u00a0 Dim rs(1 To 2) As DAO.Recordset<\/span>
\n\u00a0 Dim i As Integer<\/span><\/p>\n\u00a0 If BestaatObject(“tblRelationShips”) Then<\/span>
\n\u00a0 \u00a0 DropTabel “tblRelationShips”<\/span>
\n\u00a0 End If<\/span>
\n\u00a0 ‘maken van tabel tblRelationShips:<\/span>
\n\u00a0 Set db = CurrentDb()<\/span>
\n\u00a0 Set tdf = db.CreateTableDef(“tblRelationShips”) ‘hiermee wordt een tabel-definitie gestart<\/span><\/p>\n\u00a0 With tdf<\/span>
\n\u00a0 \u00a0 Set fld = .CreateField(“RelationID”, dbLong) ‘maak een veld van type Long aan<\/span>
\n\u00a0 \u00a0 fld.Attributes = dbAutoIncrField + dbFixedField ‘maak het veld AutoNummering<\/span>
\n\u00a0 \u00a0 .Fields.Append fld ‘voeg veld toe aan tabel-definitie<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“rel_naam”, dbText, 255) ‘maak tekst-veld (lengte 255) en voeg toe aan tabel-definitie<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“rel_ref_obj”, dbText, 255)<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“rel_ref_fld”, dbText, 255)<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“rel_obj”, dbText, 255)<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“rel_fld”, dbText, 255)<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“rel_attr”, dbLong)<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“rel_ccol”, dbLong)<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“rel_icol”, dbLong)<\/span>
\n\u00a0 End With<\/span><\/p>\n\u00a0 db.TableDefs.Append tdf ‘voeg de tabel-definitie toe aan de database<\/span>
\n\u00a0 Set fld = Nothing ‘maak object-variabele leeg<\/span>
\n\u00a0 Set tdf = Nothing<\/span>
\n\u00a0 ‘maken van een sleutel-veld:<\/span>
\n\u00a0 Set tdf = db.TableDefs(“tblRelationShips”) ‘maak contact met de tabel tblRelationShips<\/span><\/p>\n\u00a0 Set ind = tdf.CreateIndex(“PrimaryKey”) ‘start de index-definitie<\/span>
\n\u00a0 With ind<\/span>
\n\u00a0 \u00a0 .Fields.Append .CreateField(“RelationID”) ‘voeg een index op het veld RelationID toe<\/span>
\n\u00a0 \u00a0 .Unique = False<\/span>
\n\u00a0 \u00a0 .Primary = True ‘het sleutel-veld<\/span>
\n\u00a0 End With<\/span>
\n\u00a0 tdf.Indexes.Append ind ‘voeg de index toe aan de database<\/span>
\n\u00a0 tdf.Indexes.Refresh<\/span>
\n\u00a0 Set ind = Nothing<\/span>
\n\u00a0 Set tdf = Nothing<\/span>
\n\u00a0 Set db = Nothing<\/span>
\n\u00a0 Application.RefreshDatabaseWindow<\/span>
\n\u00a0 ‘vullen van de nieuwe tabel:<\/span>
\n\u00a0 Set rs(1) = CurrentDb.OpenRecordset(“SELECT szRelationship, szReferencedObject, szReferencedColumn, szObject, szColumn, grbit, ccolumn, icolumn FROM MSysRelationships “, dbOpenSnapshot) ‘maak een record-set om te lezen<\/span>
\n\u00a0 If Not rs(1).EOF Then ‘als record-set niet leeg is dan<\/span>
\n\u00a0 \u00a0 Set rs(2) = CurrentDb.OpenRecordset(“tblRelationShips”, dbOpenDynaset) ‘maak contact met tabel om te muteren<\/span>
\n\u00a0 \u00a0 rs(1).MoveFirst ‘ga naar het eerste record<\/span>
\n\u00a0 \u00a0 Do While Not rs(1).EOF ‘zolang er nog records zijn<\/span>
\n\u00a0 \u00a0 \u00a0 rs(2).AddNew ‘voeg een nieuw record toe<\/span>
\n\u00a0 \u00a0 \u00a0 For i = 0 To 7<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 rs(2).Fields(i + 1).Value = rs(1).Fields(i).Value ‘vul de overeenkomstige velden<\/span>
\n\u00a0 \u00a0 \u00a0 Next i<\/span>
\n\u00a0 \u00a0 \u00a0 rs(2).Update ‘bewaar het gevulde record<\/span>
\n\u00a0 \u00a0 \u00a0 rs(1).MoveNext ‘ga naar het volgende record<\/span>
\n\u00a0 \u00a0 Loop<\/span>
\n\u00a0 \u00a0 rs(2).Close ‘sluit record-set\/tabel<\/span>
\n\u00a0 \u00a0 Set rs(2) = Nothing<\/span>
\n\u00a0 End If<\/span>
\n\u00a0 rs(1).Close<\/span>
\n\u00a0 Set rs(1) = Nothing<\/span>
\nEnd Sub<\/span><\/p>\nDeze procedure maakt een relatie-tabel aan en vult deze met de huidige relaties.<\/p>\n
\nSub DropRelatieTabel()<\/span>
\n\u00a0 DropTabel “tblRelationShips”<\/span>
\nEnd Sub<\/span><\/p>\nDeze procedure gooit de relatie-tabel weg.<\/p>\n
\nSub MaakRelaties()<\/span>
\n\u00a0 Dim db As DAO.Database<\/span>
\n\u00a0 Dim rel As DAO.Relation<\/span>
\n\u00a0 Dim fld As DAO.Field<\/span>
\n\u00a0 Dim rs As DAO.Recordset<\/span><\/p>\n\u00a0 If BestaatObject(“tblRelationShips”) Then<\/span><\/p>\n\u00a0 \u00a0 Set db = CurrentDb()<\/span><\/p>\n\u00a0 \u00a0 Set rs = db.OpenRecordset(“tblRelationShips”, dbOpenSnapshot)<\/span>
\n\u00a0 \u00a0 If Not rs.EOF Then<\/span>
\n\u00a0 \u00a0 \u00a0 rs.MoveFirst<\/span><\/p>\n\u00a0 \u00a0 \u00a0 Do While Not rs.EOF<\/span><\/p>\n\u00a0 \u00a0 \u00a0 \u00a0 Set rel = db.CreateRelation(rs.Fields(“rel_naam”).Value) ‘geef relatie een naam<\/span><\/p>\n\u00a0 \u00a0 \u00a0 \u00a0 With rel<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 .Table = rs.Fields(“rel_ref_obj”).Value ‘wat is de originele tabel (de 1-kant)<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 .ForeignTable = rs.Fields(“rel_obj”).Value ‘wat is de beeld-tabel (de n-kant)<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 .Attributes = rs.Fields(“rel_attr”).Value\u00a0 ‘wat zijn de attributen van de relatie (integriteit, cascading deletion\/update etc.)<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 Set fld = .CreateField(rs.Fields(“rel_ref_fld”).Value) ‘wat is het sleutel-veld (aan de 1-kant)<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 fld.ForeignName = rs.Fields(“rel_fld”).Value ‘wat is de vreemde-sleutel (aan de n-kant)<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 \u00a0 .Fields.Append fld<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 End With<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 db.Relations.Append rel ‘voeg de relatie toe aan de database<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 Set fld = Nothing<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 Set rel = Nothing<\/span><\/p>\n\u00a0 \u00a0 \u00a0 \u00a0 rs.MoveNext<\/span>
\n\u00a0 \u00a0 \u00a0 Loop<\/span>
\n\u00a0 \u00a0 End If<\/span>
\n\u00a0 \u00a0 rs.Close<\/span>
\n\u00a0 \u00a0 Set rs = Nothing<\/span>
\n\u00a0 \u00a0 Set db = Nothing<\/span>
\n\u00a0 End If<\/span>
\nEnd Sub<\/span><\/p>\nDeze procedure maakt de relaties aan.<\/p>\n
\nSub BackUpObjecten()<\/span>
\n\u00a0 Dim dbname As String<\/span>
\n\u00a0 Dim ws As Workspace<\/span>
\n\u00a0 Dim db As Database<\/span>
\n\u00a0 Dim rs As DAO.Recordset<\/span>
\n\u00a0 Dim rapporten() As String<\/span>
\n\u00a0 Dim queries() As String<\/span>
\n\u00a0 Dim tabellen() As String<\/span>
\n\u00a0 Dim prfx As String<\/span>
\n\u00a0 Dim t As Integer<\/span>
\n\u00a0 Dim SQL As String<\/span>
\n\u00a0 ‘inventariseer welke objecten in aanmerking komen om naar de backup te gaan:<\/span>
\n\u00a0 ReDim rapporten(0 To 0)<\/span>
\n\u00a0 ReDim queries(0 To 0)<\/span>
\n\u00a0 ReDim tabellen(0 To 0)<\/span>
\n\u00a0 SQL = “SELECT Name FROM MSysObjects WHERE Type <> 8” ‘in MSysObjects staan alle Access-objecten; Type=8 duidt op een relatie-naam<\/span>
\n\u00a0 Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)<\/span>
\n\u00a0 If Not rs.EOF Then<\/span>
\n\u00a0 \u00a0 rs.MoveFirst<\/span>
\n\u00a0 \u00a0 Do While Not rs.EOF<\/span>
\n\u00a0 \u00a0 \u00a0 prfx = UCase(Left(rs.Fields(0).Value, 3)) ‘bepaal de prefix van het object<\/span>
\n\u00a0 \u00a0 \u00a0 If prfx = “QRY” Then<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 ReDim Preserve queries(0 To UBound(queries) + 1)<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 queries(UBound(queries)) = rs.Fields(0).Value<\/span>
\n\u00a0 \u00a0 \u00a0 End If<\/span>
\n\u00a0 \u00a0 \u00a0 If prfx = “RPT” Then<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 ReDim Preserve rapporten(0 To UBound(rapporten) + 1)<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 rapporten(UBound(rapporten)) = rs.Fields(0).Value<\/span>
\n\u00a0 \u00a0 \u00a0 End If<\/span>
\n\u00a0 \u00a0 \u00a0 If prfx = “TBL” Then<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 ReDim Preserve tabellen(0 To UBound(tabellen) + 1)<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 tabellen(UBound(tabellen)) = rs.Fields(0).Value<\/span>
\n\u00a0 \u00a0 \u00a0 End If<\/span>
\n\u00a0 \u00a0 \u00a0 rs.MoveNext<\/span>
\n\u00a0 \u00a0 Loop<\/span>
\n\u00a0 End If<\/span>
\n\u00a0 rs.Close<\/span>
\n\u00a0 Set rs = Nothing<\/span><\/p>\n\u00a0 dbname = Application.CurrentProject.Path & “\\backupdb.bak.mdb” ‘maak backup-databasse aan (bestand)<\/span>
\n\u00a0 If FileExists(dbname) Then ‘als backup-database al bestaat dan<\/span>
\n\u00a0 \u00a0 Kill dbname ‘delete het<\/span>
\n\u00a0 End If<\/span>
\n\u00a0 Set ws = DBEngine.Workspaces(0)<\/span>
\n\u00a0 Set db = ws.CreateDatabase(dbname, dbLangGeneral) ‘cre\u00eber backup-database (inhoudelijk)<\/span>
\n\u00a0 db.Close<\/span>
\n\u00a0 Set db = Nothing<\/span>
\n\u00a0 ws.Close<\/span>
\n\u00a0 Set ws = Nothing<\/span>
\n\u00a0 For t = 1 To UBound(rapporten)<\/span>
\n\u00a0 \u00a0 DoCmd.CopyObject dbname, rapporten(t), acReport, rapporten(t) ‘copieer alle rapporten naar de backup-database<\/span>
\n\u00a0 Next t<\/span>
\n\u00a0 For t = 1 To UBound(queries)<\/span>
\n\u00a0 \u00a0 DoCmd.CopyObject dbname, queries(t), acQuery, queries(t)\u00a0‘copieer alle queries naar de backup-database<\/span>
\n\u00a0 Next t<\/span>
\n\u00a0 For t = 1 To UBound(tabellen)<\/span>
\n\u00a0 \u00a0 DoCmd.CopyObject dbname, tabellen(t), acTable, tabellen(t)\u00a0‘copieer alle tabellen naar de backup-database<\/span>
\n\u00a0 Next t<\/span>
\n\u00a0 MsgBox “De backup is gemaakt onder de naam: ” & dbname, vbOKOnly + vbInformation, “BACKUP KLAAR”<\/span>
\nEnd Sub<\/span><\/p>\nDeze 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.<\/p>\n
\nSub VerwijderRelaties()<\/span>
\n\u00a0 Dim rs As DAO.Recordset<\/span>
\n\u00a0 Dim SQL As String<\/span>
\n\u00a0 Dim relname() As String<\/span>
\n\u00a0 Dim i As Integer, a As Integer<\/span><\/p>\n\u00a0 a = 0<\/span>
\n\u00a0 SQL = “SELECT szRelationship FROM MSysRelationships WHERE LEFT(UCASE(szRelationship),3) = ‘TBL'”<\/span>
\n\u00a0 Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)<\/span>
\n\u00a0 If Not rs.EOF Then<\/span>
\n\u00a0 \u00a0 ReDim relname(1 To 1)<\/span>
\n\u00a0 \u00a0 a = 1<\/span>
\n\u00a0 \u00a0 rs.MoveFirst<\/span>
\n\u00a0 \u00a0 Do While Not rs.EOF<\/span>
\n\u00a0 \u00a0 \u00a0 relname(UBound(relname)) = rs.Fields(0).Value<\/span>
\n\u00a0 \u00a0 \u00a0 rs.MoveNext<\/span>
\n\u00a0 \u00a0 \u00a0 If Not rs.EOF Then<\/span>
\n\u00a0 \u00a0 \u00a0 \u00a0 ReDim Preserve relname(1 To UBound(relname) + 1)<\/span>
\n\u00a0 \u00a0 \u00a0 End If<\/span>
\n\u00a0 \u00a0 Loop<\/span>
\n\u00a0 End If<\/span>
\n\u00a0 rs.Close<\/span>
\n\u00a0 Set rs = Nothing<\/span>
\n\u00a0 If a > 0 Then<\/span>
\n\u00a0 \u00a0 For i = 1 To UBound(relname)<\/span>
\n\u00a0 \u00a0 \u00a0 VerwijderRelatie relname(i)<\/span>
\n\u00a0 \u00a0 Next i<\/span>
\n\u00a0 End If<\/span>
\nEnd Sub<\/span><\/p>\nDeze procedure verwijdert alle huidige relaties.<\/p>\n
\n |