Codebeispiele

Hier sind ein paar Modulbeispiele aufgeführt, die man immer wieder gebrauchen koennte. Die meisten Beispiele sind in ACCESS 2003 VBA geschrieben. Die Codebeispiele könnt Ihr kopieren, verändern, einbauen oder verbessern. Bitte denkt daran, daß ich für etwaige Fehlfunktionen keine Garantie übernehme.

Import von Tabellen diverser Access Datenbanken aus einem Verzeichnis.

Public Sub IMPORT_DATENBANK()

Dim DATEI, PFAD, DBPFAD, REMTAB, STRTDEF As String
Dim TDEF As TableDef
Dim DTAB As Database
Ausschalten der Warnmeldungen
DoCmd.SetWarnings False
Pfad und Auflistung der Datenbanken
DBPFAD = "C:\Datenbanken\Beispiele\"
DATEI = Dir(DBPFAD, vbNormal)
PFAD = DBPFAD & DATEI
Schleife durchläuft den Ordner bis zur letzten Datenbank
Do While DATEI <> ""
If InStr(1, DATEI, ".mdb", vbTextCompare) > 0 Then
Öffnen der Datenbank
Set DTAB = OpenDatabase(DBPFAD & DATEI)
Import der Tabellen aus der geöffneten Datenbank
For Each TDEF In DTAB.TableDefs
STRTDEF = TDEF.Name
Überprüfung gewisser Sonderzeichen im Namen der Tabelle
If InStr(1, STRTDEF, "MSys", vbTextCompare) = 0 Then
Import der Tabelle
DoCmd.TransferDatabase acImport, "Microsoft Access", DBPFAD & DATEI, _
acTable, STRTDEF, STRTDEF, False
End If
End If
Next
Schliessen der aktuellen Datenbank
DTAB.Close
End If
Zur nächsten Datenbank im Verzeichnis springen
DATEI = Dir
Loop
Einschaltung der Warnmeldung
DoCmd.SetWarnings True
End Sub

Export der Tabellen in ein vorhandenes Verzeichnis

Public Sub Tabellen_Export()

Dim DB, NDB As DAO.Database
Dim TD As DAO.TableDef
Dim FD As DAO.Field
Dim STD, NEWDB As String
Ausschalten der Warnmeldungen
DoCmd.SetWarnings False
Die aktuelle Datenbank setzen
Set DB = CurrentDb
Schleife durchläuft die aktuelle Datenbank
For Each TD In DB.TableDefs
STD = TD.Name
Überprüfung gewisser Sonderzeichen im Namen der Tabelle
If InStr(1, STD, "MSys", vbTextCompare) = 0 Then
Datenbank im vordefinierten Ordner erstellen
Set NDB = DBEngine.Workspaces(0).CreateDatabase _
("C:\Datenbanken\Beispiele\" & STD & ".mdb", dbLangGeneral)
Datenbank wird nach Erstellung geschlossen
NDB.Close
Set NDB = Nothing
Neue Datenbank setzen
NEWDB = "C:\Datenbanken\Beispiele\" & STD & ".mdb"
Export der aktuellen Tabellen in die neue Datenbank
DoCmd.TransferDatabase acExport, "Microsoft Access", NEWDB, acTable, STD, STD, False, False
End If
Next
End Sub

Copyright © 2009 Solution2BitClean. Alle Rechte vorbehalten.