
Microsoft Access Office VB VBA Help and Examples

De-replicating a database

This piece of code will copy all objects out of your current replica database into a database you specify in the exportbdbs string, recreating tables as it goes on and not copying the replica id fields. This code is placed in a module of the replica database you want to export from. Run it from there. It will not affect your replica database.

Now supports Export Queries, Export Forms, Export Reports, Export Modules , Export Macros and Recreate Relationships.

Option Compare Database
Option Explicit
'Export Tables Module Sub
'Code to export all the tables from a replica into a new database
'without the replica definitions
'Written by John Hawkins
Private Sub Export_Tables()
    Dim Dbs As Database
    Dim Tableon As TableDef
    Dim Sqlstr As String
    Dim FdfField As Fields
    Dim Fieldname As Field
    Dim QueryOn As QueryDef
    Dim Ret As Integer
    Dim ExportDbs As String
    Dim FormOn As Document
    Dim ReportOn As Document
    Dim ModuleOn As Document
    Dim MacroOn As Document
    Dim Relationship As Relation
    Dim Relnew As Relation
    Dim RelField As Field
    Dim ExpDbs As Database
    Dim X As Integer
    Dim Idx As Index
    Dim IdxNew As Index
    Dim Idxfield As Field
    Dim PropField As Property
    ExportDbs = "c:\eid\db1.mdb"
    Set Dbs = CurrentDb
    Set ExpDbs = OpenDatabase(ExportDbs)

'Export Tables
    Ret = MsgBox("Do you want to export all table to database " & ExportDbs & "?", vbYesNo)
    If Ret = vbYes Then
        For Each Relationship In ExpDbs.Relations
            ExpDbs.Relations.Delete Relationship.Name
        Next
        For Each Tableon In Dbs.TableDefs
            Sqlstr = "SELECT "
            If Left$(Tableon.Name, 4) <> "Msys" Then
                Set FdfField = Tableon.Fields
                For Each Fieldname In FdfField
                    If Left$(Fieldname.Name, 2) <> "s_" Then
                        Sqlstr = Sqlstr & " [" & Tableon.Name & "].[" & Fieldname.Name & "],"
                    End If
                Next
                'strip off the last comma
                Sqlstr = Left$(Sqlstr, Len(Sqlstr) - 1)
                Sqlstr = Sqlstr & " INTO [" & Tableon.Name & "] IN '" & ExportDbs & "' FROM [" & Tableon.Name & "];"
                DoCmd.SetWarnings False
                DoCmd.RunSQL Sqlstr
                DoCmd.SetWarnings True
                'recreate the indexes
                ExpDbs.TableDefs.Refresh
                For Each Idx In Tableon.Indexes
                    If Left$(Idx.Name, 2) <> "s_" Then
                        'create index and properties for
                        Set IdxNew = ExpDbs.TableDefs(Tableon.Name).CreateIndex(Idx.Name)
                        IdxNew.Unique = Idx.Unique
                        IdxNew.Required = Idx.Required
                        IdxNew.IgnoreNulls = Idx.IgnoreNulls
                        IdxNew.Primary = Idx.Primary
                        IdxNew.Name = Idx.Name
                        'recreate fields in indexes
                        For Each Idxfield In Idx.Fields
                            IdxNew.Fields.Append IdxNew.CreateField(Idxfield.Name)
                        Next
                        ExpDbs.TableDefs(Tableon.Name).Indexes.Append IdxNew
                    End If
                Next
            End If
        Next
    End If
'Export Queries
    Ret = MsgBox("Do you want to export all queries to database " & ExportDbs & "?", vbYesNo)
    If Ret = vbYes Then
        For Each QueryOn In Dbs.QueryDefs
            DoCmd.CopyObject ExportDbs, QueryOn.Name, acQuery, QueryOn.Name
        Next
    End If
'Export Forms
    Ret = MsgBox("Do you want to export all forms to database " & ExportDbs & "?", vbYesNo)
    If Ret = vbYes Then
        For Each FormOn In Dbs.Containers!Forms.Documents
            DoCmd.CopyObject ExportDbs, FormOn.Name, acForm, FormOn.Name
        Next
    End If
'Export Reports
    Ret = MsgBox("Do you want to export all reports to database " & ExportDbs & "?", vbYesNo)
    If Ret = vbYes Then
        For Each ReportOn In Dbs.Containers!Reports.Documents
            DoCmd.CopyObject ExportDbs, ReportOn.Name, acReport, ReportOn.Name
        Next
    End If
'Export Modules
    Ret = MsgBox("Do you want to export all Modules to database " & ExportDbs & "?", vbYesNo)
    If Ret = vbYes Then
        For Each ModuleOn In Dbs.Containers!Modules.Documents
            DoCmd.CopyObject ExportDbs, ModuleOn.Name, acModule, ModuleOn.Name
        Next
    End If
'Export Macros
    Ret = MsgBox("Do you want to export all Macros to database " & ExportDbs & "?", vbYesNo)
    If Ret = vbYes Then
        For Each MacroOn In Dbs.Containers!Scripts.Documents
            DoCmd.CopyObject ExportDbs, MacroOn.Name, acMacro, MacroOn.Name
        Next
    End If
'Export Relationships
    Ret = MsgBox("Do you want to recreate Relationships to database " & ExportDbs & "? This will delete all current relationships.", vbYesNo)
    If Ret = vbYes Then
        ExpDbs.Relations.Refresh
        For Each Relationship In ExpDbs.Relations
            ExpDbs.Relations.Delete Relationship.Name
        Next
        Dbs.Relations.Refresh
        ExpDbs.Relations.Refresh
        For Each Relationship In Dbs.Relations
            Set Relnew = ExpDbs.CreateRelation(Relationship.Name & Int(Rnd(1) * 100), Relationship.Table, Relationship.ForeignTable, Relationship.Attributes)
                X = 0
                For Each RelField In Relationship.Fields
                    Relnew.Fields.Append Relnew.CreateField(RelField.Name)
                    Relnew.Fields(X).ForeignName = RelField.ForeignName
                    X = X + 1
                Next
            ExpDbs.Relations.Append Relnew
        Next
    End If
    ExpDbs.Close
    DBEngine.CompactDatabase ExportDbs, "c:\temp.mdb"
    Kill ExportDbs
    FileCopy "c:\temp.mdb", ExportDbs
    Kill "c:\temp.mdb"
End Sub

HOME SEARCH SITE PRIVACY POLICY CONTACT

The code and application content of this site is copyright of Smiley I.T. and as such reproduction in any form which is for commercial use requires the permission of the Webmaster. Any use of this code for non-commercial use only requires a link or comment back to the original page you took the code from.