Function copy_module(modulname$, zieldb$) 'Author: Heiko Hommes 'Create: 2.12.2003 'Funktion: Kopiert Access-Objekte von Quelldatenbank nach Zieldatenbank 'Zusatz: Übergibt man als Modulname "ALLE", dann werden alle Objekte 1:1 von A nach B kopiert ' Übergibt man den Modulnamen (Gross und Kleinschreibung beachten) dann kopiert man auch ' nur das Modul ' Als Zieldb gibt man den kompletten Pfad mit Datenbank an. d:\daten...\xy.mdb) 'Bemerkung: Super Programm 'On Error GoTo fehler Dim sys_db As Database Dim ziel_db As Database Dim sysob_rs As Recordset Set sys_db = DBEngine(0)(0) Set ziel_db = DBEngine(0).OpenDatabase(zieldb, , False) Set sysob_rs = sys_db.OpenRecordset("MSysObjects") sysob_rs.MoveFirst main: Do While Not sysob_rs.EOF If Mid(sysob_rs![Name], 1, 4) <> "MSys" And _ sysob_rs![Name] <> "AccessLayout" And _ sysob_rs![Name] <> "Databases" And _ sysob_rs![Name] <> "Forms" And _ sysob_rs![Name] <> "Funktionen" And _ sysob_rs![Name] <> "Modules" And _ sysob_rs![Name] <> "Relationships" And _ sysob_rs![Name] <> "Reports" And _ sysob_rs![Name] <> "Scripts" And _ sysob_rs![Name] <> "SysRel" And _ sysob_rs![Name] <> "Tables" And _ sysob_rs![Name] <> "UserDefined" Then If modulname = "ALLE" Then If sysob_rs![Type] = 1 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acTable, sysob_rs![Name] If sysob_rs![Type] = -32761 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acModule, sysob_rs![Name] If sysob_rs![Type] = -32766 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acMacro, sysob_rs![Name] If sysob_rs![Type] = -32768 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acForm, sysob_rs![Name] If sysob_rs![Type] = -32764 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acReport, sysob_rs![Name] If sysob_rs![Type] = 5 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acQuery, sysob_rs![Name] Else If sysob_rs![Name] = modulname Then If sysob_rs![Type] = 1 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acTable, sysob_rs![Name] If sysob_rs![Type] = -32761 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acModule, sysob_rs![Name] If sysob_rs![Type] = -32766 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acMacro, sysob_rs![Name] If sysob_rs![Type] = -32768 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acForm, sysob_rs![Name] If sysob_rs![Type] = -32764 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acReport, sysob_rs![Name] If sysob_rs![Type] = 5 Then DoCmd.CopyObject zieldb, sysob_rs![Name], acQuery, sysob_rs![Name] Exit Function End If End If End If sysob_rs.MoveNext Loop fehler: Resume Next If Not sysob_rs.EOF Then sysob_rs.MoveNext GoTo main Else Exit Function End If End Function