definiteIymaybe/basUnReplicate.bas

## basUnReplicate.bas
Attribute VB_Name = "basUnReplicate"
Option Compare Database
Option Explicit

Public Function UnReplicate() As Boolean
' This function copies or imports all the objects and database startup
' properties from a replicated database into an un-replicated database.
' It removes tablename_Conflict tables and removes replication-related
' fields like s_GUID, etc.

' UnReplicate() Version 1.1.0
' Copyright © 2009 Extra Mile Data, www.extramiledata.com.
' For questions or issues, please contact support@extramiledata.com.
' Use (at your own risk) and modify freely as long as proper credit is given.

' The core logic for the table and query copy was modified from:
' http://www.gab2001uk.com/visualbasic/daovsado/daocopy.htm

On Error GoTo Err_UnReplicate

    ' FileDialog requires a reference to a Microsoft Office Object Library
    ' (10 [Access 2002] or later).
    Dim fdlPick As Office.FileDialog
    Dim varFileRep
    Dim varFileNew

    ' DOA requires a reference to Microsoft DAO Object Library, or for
    ' Access 2007 and later, the Microsoft Office Access database engine
    ' Object Library.

    ' Database.
    Dim dbRep As DAO.Database
    Dim dbNew As DAO.Database

    ' For copying tables and indexes.
    Dim tblRep As DAO.TableDef
    Dim tblNew As DAO.TableDef
    Dim fldRep As DAO.Field
    Dim fldNew As DAO.Field
    Dim idxRep As DAO.Index
    Dim idxNew As DAO.Index

    ' For copying data.
    Dim rstRep As DAO.Recordset
    Dim rstNew As DAO.Recordset
    Dim intC As Integer

    ' For copying table relationships.
    Dim relRep As DAO.Relation
    Dim relNew As DAO.Relation

    ' For copying queries.
    Dim qryRep As DAO.QueryDef
    Dim qryNew As DAO.QueryDef

    ' For copying startup options.
    Dim avarSUOpt
    Dim strSUOpt As String
    Dim varValue
    Dim varType
    Dim prpRep As DAO.Property
    Dim prpNew As DAO.Property

    ' For importing forms, reports, modules, and macros.
    Dim appNew As New Access.Application
    Dim doc As DAO.Document

    ' Get a file dialog and ask the user for the replicated database.
    ' If they cancel, then exit.
    Set fdlPick = Application.FileDialog(msoFileDialogFilePicker)
    With fdlPick
        .AllowMultiSelect = False
        .Title = "Select the replicated database"
        .Filters.Clear
        .Filters.Add "Access Databases", "*.MDB"

        If .Show = True Then
            varFileRep = .SelectedItems(1)
        Else
            GoTo Exit_UnReplicate
        End If
    End With ' fdlPick

    ' Open the replicated database, not in exclusive mode.
    Set dbRep = OpenDatabase(varFileRep, False)

    ' Get a file dialog and ask the user for the replicated database.
    ' If they cancel, then exit.
    Set fdlPick = Nothing
    Set fdlPick = Application.FileDialog(msoFileDialogFilePicker)
    With fdlPick
        .AllowMultiSelect = False
        .Title = "Select the new un-replicated database"
        .Filters.Clear
        .Filters.Add "Access Databases", "*.MDB"
        .Filters.Add "Access Databases", "*.ACCDB"

        If .Show = True Then
            varFileNew = .SelectedItems(1)
        Else
            GoTo Exit_UnReplicate
        End If
    End With ' fdlPick

    ' Open the new database, in exclusive mode.
    Set dbNew = OpenDatabase(varFileNew, True)

    DoEvents

    ' Turn on the hourglass.
    DoCmd.Hourglass True

    '********************
    Debug.Print "Copy Tables"
    '********************
    ' Loop through the collection of table definitions.
    For Each tblRep In dbRep.TableDefs

        ' Ignore system tables and _Confict tables.
        If Left(tblRep.Name, 4) <> "MSys" And _
            InStr(1, tblRep.Name, "_Conflict", vbTextCompare) = 0 Then

            '***** Table definition
            ' Create a table definition with the same name.
            Set tblNew = dbNew.CreateTableDef(tblRep.Name)

            ' Set properties.
            tblNew.ValidationRule = tblRep.ValidationRule
            tblNew.ValidationText = tblRep.ValidationText

            ' Loop through the collection of fields in the table.
            For Each fldRep In tblRep.Fields

                ' Ignore replication-related fields:
                ' Gen_XXX, s_ColLineage, s_Generation, s_GUID, s_Lineage
                If Left(fldRep.Name, 2) <> "s_" And _
                    Left(fldRep.Name, 4) <> "Gen_" Then

                    '***** Field definition
                    Set fldNew = tblNew.CreateField(fldRep.Name, fldRep.Type, _
                        fldRep.Size)

                    ' Set properties.
                    On Error Resume Next
                    fldNew.Attributes = fldRep.Attributes
                    fldNew.AllowZeroLength = fldRep.AllowZeroLength
                    fldNew.DefaultValue = fldRep.DefaultValue
                    fldNew.Required = fldRep.Required
                    fldNew.Size = fldRep.Size

                    ' Append the field.
                    tblNew.Fields.Append fldNew
                    On Error GoTo Err_UnReplicate
                End If
            Next fldRep

            '***** Index definition

            ' Loop through the collection of indexes.
            For Each idxRep In tblRep.Indexes

                ' Ignore replication-related indexes:
                ' s_Generation, s_GUID
                If Left(idxRep.Name, 2) <> "s_" Then

                    ' Ignore indices set as part of Relation Objects
                    If Not idxRep.Foreign Then

                        ' Create an index with the same name.
                        Set idxNew = tblNew.CreateIndex(idxRep.Name)

                        ' Set properties.
                        idxNew.Clustered = idxRep.Clustered
                        idxNew.IgnoreNulls = idxRep.IgnoreNulls
                        idxNew.Primary = idxRep.Primary
                        idxNew.Required = idxRep.Required
                        idxNew.Unique = idxRep.Unique

                        ' Loop through the collection of index fields.
                        For Each fldRep In idxRep.Fields
                            ' Create an index field with the same name.
                            Set fldNew = idxNew.CreateField(fldRep.Name)
                            ' Set properties.
                            fldNew.Attributes = fldRep.Attributes
                            ' Append the index field.
                            idxNew.Fields.Append fldNew
                        Next fldRep

                        ' Append the index to the table.
                        tblNew.Indexes.Append idxNew
                    End If
                End If
            Next idxRep

            ' Append the table.
            dbNew.TableDefs.Append tblNew
        End If
    Next tblRep

    '********************
    Debug.Print "Copy Data"
    '********************
    ' Loop through the list of table definitions.
    For Each tblRep In dbRep.TableDefs

        ' Ignore system tables and _Confict tables.
        If Left(tblRep.Name, 4) <> "MSys" And _
            InStr(1, tblRep.Name, "_Conflict", vbTextCompare) = 0 Then

            ' Open a recordset for the un-replicated table.
            Set rstNew = dbNew.OpenRecordset(tblRep.Name, dbOpenTable)
            ' Open a recordset for the replicated table.
            Set rstRep = dbRep.OpenRecordset(tblRep.Name, dbOpenTable)

            ' Continue if there are records.
            If Not rstRep.BOF Then

                ' Move to the first record.
                rstRep.MoveFirst

                ' Loop through all the replicated table records.
                Do Until rstRep.EOF
                    ' Add a record to the un-replicated table.
                    rstNew.AddNew
                    ' For each field in the un-replicated table, set the value
                    ' to the value in the related field of the replicated table.
                    For intC = 0 To rstNew.Fields.Count - 1
                        rstNew.Fields(intC).Value = _
                            rstRep.Fields(rstNew.Fields(intC).Name).Value
                    Next
                    ' Update the un-replicated table.
                    rstNew.Update
                    ' Move to the next replicated table record.
                    rstRep.MoveNext
                Loop ' rstRep
            End If

            ' Close the un-replicated recordset.
            rstNew.Close
            ' Close the replicated recordset.
            rstRep.Close
        End If
    Next tblRep

    '********************
    Debug.Print "Copy Relationships"
    '********************
    ' Loop through the collection of table relationships.
    For Each relRep In dbRep.Relations

        ' Create a relation with the same name.
        Set relNew = dbNew.CreateRelation(relRep.Name, relRep.Table, _
            relRep.ForeignTable, relRep.Attributes)

        ' Loop through the collection of relation fields.
        For Each fldRep In relRep.Fields

            ' Append a relation field with the same name.
            relNew.Fields.Append relNew.CreateField(fldRep.Name)

            ' Give the relation field the same foreign name.
            relNew.Fields(fldRep.Name).ForeignName = _
                relRep.Fields(fldRep.Name).ForeignName
        Next fldRep

        ' Append the the relation to the database.
        dbNew.Relations.Append relNew
    Next relRep

    '********************
    Debug.Print "Copy Queries"
    '********************
    ' Loop through the collection of query definitions.
    ' We use this method rather than TransferDatabase action used below
    ' because both tables and queries are listed in the Tables container.
    For Each qryRep In dbRep.QueryDefs

        ' Create a query definition with the same name and SQL.
        Set qryNew = dbNew.CreateQueryDef(qryRep.Name, qryRep.SQL)

        ' Set properties.
        qryNew.Connect = qryRep.Connect
        qryNew.MaxRecords = qryRep.MaxRecords
        qryNew.ReturnsRecords = qryRep.ReturnsRecords

        ' Append the query definition to the database (NOT NECESSARY).
        ' dbRep.QueryDefs.Append qryNew
    Next qryRep

    '********************
    Debug.Print "Copy Startup Options"
    '********************
    ' Create an array of startup options to examine.
    avarSUOpt = Array( _
        "AllowBreakIntoCode", _
        "AllowBuiltInToolbars", _
        "AllowFullMenus", _
        "AllowShortcutMenus", _
        "AllowSpecialKeys", _
        "AllowToolbarChanges", _
        "AppIcon", _
        "AppTitle", _
        "StartupForm", _
        "StartupMenuBar", _
        "StartupShortcutMenuBar", _
        "StartupShowDBWindow", _
        "StartupShowStatusBar")

    ' Handle errors in this section of code.
    On Error Resume Next

    ' Loop through the array.
    For intC = 0 To UBound(avarSUOpt)

        ' Get the name of the property from the array.
        strSUOpt = avarSUOpt(intC)

        ' Clear and continue if there is an error.
        Err.Clear

        ' Try to get the property in the replicated database.
        Set prpRep = dbRep.Properties(strSUOpt)

        If Err.Number = 0 Then
            ' The property exists in the replicated database.
            ' Get its Value and Type.
            varValue = prpRep.Value
            varType = prpRep.Type

            ' Try to get the property in the un-replicated database.
            Set prpNew = dbNew.Properties(strSUOpt)

            If Err.Number = 0 Then
                ' The property exists.  Reset its value to the
                ' replicated database value.
                prpNew.Value = varValue
            Else
                ' The property does not exist yet.  Create the property,
                ' using the replicated database type and value, and
                ' then append it to the database.
                Set prpNew = dbNew.CreateProperty(strSUOpt, varType, varValue)
                dbNew.Properties.Append prpNew
            End If
        Else
            ' The property does not exist in the replicated
            ' database, so ignore it.
        End If
    Next intC

    ' Turn overall error handling back on.
    On Error GoTo Err_UnReplicate

    ' Close the un-replicated database so that it can be opened
    ' exclusively using GetObject.
    dbNew.Close

    ' Get the Access application object for the un-replicated database.
    Set appNew = GetObject(varFileNew)
    appNew.Visible = False

    '********************
    Debug.Print "Import Forms"
    '********************
    ' Loop through the collection of forms in the replicated database
    ' and import each one.  This automatically removes the replicated flag.
    For Each doc In dbRep.Containers("Forms").Documents
        appNew.DoCmd.TransferDatabase acImport, "Microsoft Access", _
            varFileRep, acForm, doc.Name, doc.Name
    Next doc

    '********************
    Debug.Print "Import Reports"
    '********************
    ' Loop through the collection of reports in the replicated database
    ' and import each one.  This automatically removes the replicated flag.
    For Each doc In dbRep.Containers("Reports").Documents
        appNew.DoCmd.TransferDatabase acImport, "Microsoft Access", _
            varFileRep, acReport, doc.Name, doc.Name
    Next doc

    '********************
    Debug.Print "Import Modules"
    '********************
    ' Loop through the collection of modules in the replicated database
    ' and import each one.  This automatically removes the replicated flag.
    For Each doc In dbRep.Containers("Modules").Documents
        appNew.DoCmd.TransferDatabase acImport, "Microsoft Access", _
            varFileRep, acModule, doc.Name, doc.Name
    Next doc

    '********************
    Debug.Print "Import Macros"
    '********************
    ' Loop through the collection of macros in the replicated database
    ' and import each one.  This automatically removes the replicated flag.
    For Each doc In dbRep.Containers("Scripts").Documents
        appNew.DoCmd.TransferDatabase acImport, "Microsoft Access", _
            varFileRep, acMacro, doc.Name, doc.Name
    Next doc

    ' Close the un-replicated database.
    appNew.Quit

    ' Message the user.
    MsgBox "UnReplicate is complete."
    Debug.Print "Complete"

    UnReplicate = True

Exit_UnReplicate:
    On Error Resume Next
    ' Turn off the hourglass.
    DoCmd.Hourglass False

    ' Clean up.
    Set fdlPick = Nothing

    Set idxRep = Nothing
    Set idxNew = Nothing
    Set fldRep = Nothing
    Set fldNew = Nothing
    Set tblRep = Nothing
    Set tblNew = Nothing

    rstRep.Close
    rstNew.Close
    Set rstRep = Nothing
    Set rstNew = Nothing

    Set relRep = Nothing
    Set relNew = Nothing

    Set qryRep = Nothing
    Set qryNew = Nothing

    Set prpRep = Nothing
    Set prpNew = Nothing

    dbRep.Close
    dbNew.Close
    Set dbRep = Nothing
    Set dbNew = Nothing

    Set doc = Nothing
    appNew.Quit
    Set appNew = Nothing

    Exit Function

Err_UnReplicate:
    MsgBox Err.Number & " " & Err.Description, vbCritical, "UnReplicate()"
    UnReplicate = False
    Resume Exit_UnReplicate:

End Function
	Attribute VB_Name = "basUnReplicate"
	Option Compare Database
	Option Explicit

	Public Function UnReplicate() As Boolean
	' This function copies or imports all the objects and database startup
	' properties from a replicated database into an un-replicated database.
	' It removes tablename_Conflict tables and removes replication-related
	' fields like s_GUID, etc.

	' UnReplicate() Version 1.1.0
	' Copyright © 2009 Extra Mile Data, www.extramiledata.com.
	' For questions or issues, please contact support@extramiledata.com.
	' Use (at your own risk) and modify freely as long as proper credit is given.

	' The core logic for the table and query copy was modified from:
	' http://www.gab2001uk.com/visualbasic/daovsado/daocopy.htm

	On Error GoTo Err_UnReplicate

	' FileDialog requires a reference to a Microsoft Office Object Library
	' (10 [Access 2002] or later).
	Dim fdlPick As Office.FileDialog
	Dim varFileRep
	Dim varFileNew

	' DOA requires a reference to Microsoft DAO Object Library, or for
	' Access 2007 and later, the Microsoft Office Access database engine
	' Object Library.

	' Database.
	Dim dbRep As DAO.Database
	Dim dbNew As DAO.Database

	' For copying tables and indexes.
	Dim tblRep As DAO.TableDef
	Dim tblNew As DAO.TableDef
	Dim fldRep As DAO.Field
	Dim fldNew As DAO.Field
	Dim idxRep As DAO.Index
	Dim idxNew As DAO.Index

	' For copying data.
	Dim rstRep As DAO.Recordset
	Dim rstNew As DAO.Recordset
	Dim intC As Integer

	' For copying table relationships.
	Dim relRep As DAO.Relation
	Dim relNew As DAO.Relation

	' For copying queries.
	Dim qryRep As DAO.QueryDef
	Dim qryNew As DAO.QueryDef

	' For copying startup options.
	Dim avarSUOpt
	Dim strSUOpt As String
	Dim varValue
	Dim varType
	Dim prpRep As DAO.Property
	Dim prpNew As DAO.Property

	' For importing forms, reports, modules, and macros.
	Dim appNew As New Access.Application
	Dim doc As DAO.Document

	' Get a file dialog and ask the user for the replicated database.
	' If they cancel, then exit.
	Set fdlPick = Application.FileDialog(msoFileDialogFilePicker)
	With fdlPick
	.AllowMultiSelect = False
	.Title = "Select the replicated database"
	.Filters.Clear
	.Filters.Add "Access Databases", "*.MDB"

	If .Show = True Then
	varFileRep = .SelectedItems(1)
	Else
	GoTo Exit_UnReplicate
	End If
	End With ' fdlPick

	' Open the replicated database, not in exclusive mode.
	Set dbRep = OpenDatabase(varFileRep, False)

	' Get a file dialog and ask the user for the replicated database.
	' If they cancel, then exit.
	Set fdlPick = Nothing
	Set fdlPick = Application.FileDialog(msoFileDialogFilePicker)
	With fdlPick
	.AllowMultiSelect = False
	.Title = "Select the new un-replicated database"
	.Filters.Clear
	.Filters.Add "Access Databases", "*.MDB"
	.Filters.Add "Access Databases", "*.ACCDB"

	If .Show = True Then
	varFileNew = .SelectedItems(1)
	Else
	GoTo Exit_UnReplicate
	End If
	End With ' fdlPick

	' Open the new database, in exclusive mode.
	Set dbNew = OpenDatabase(varFileNew, True)

	DoEvents

	' Turn on the hourglass.
	DoCmd.Hourglass True

	'********************
	Debug.Print "Copy Tables"
	'********************
	' Loop through the collection of table definitions.
	For Each tblRep In dbRep.TableDefs

	' Ignore system tables and _Confict tables.
	If Left(tblRep.Name, 4) <> "MSys" And _
	InStr(1, tblRep.Name, "_Conflict", vbTextCompare) = 0 Then

	'***** Table definition
	' Create a table definition with the same name.
	Set tblNew = dbNew.CreateTableDef(tblRep.Name)

	' Set properties.
	tblNew.ValidationRule = tblRep.ValidationRule
	tblNew.ValidationText = tblRep.ValidationText

	' Loop through the collection of fields in the table.
	For Each fldRep In tblRep.Fields

	' Ignore replication-related fields:
	' Gen_XXX, s_ColLineage, s_Generation, s_GUID, s_Lineage
	If Left(fldRep.Name, 2) <> "s_" And _
	Left(fldRep.Name, 4) <> "Gen_" Then

	'***** Field definition
	Set fldNew = tblNew.CreateField(fldRep.Name, fldRep.Type, _
	fldRep.Size)

	' Set properties.
	On Error Resume Next
	fldNew.Attributes = fldRep.Attributes
	fldNew.AllowZeroLength = fldRep.AllowZeroLength
	fldNew.DefaultValue = fldRep.DefaultValue
	fldNew.Required = fldRep.Required
	fldNew.Size = fldRep.Size

	' Append the field.
	tblNew.Fields.Append fldNew
	On Error GoTo Err_UnReplicate
	End If
	Next fldRep

	'***** Index definition

	' Loop through the collection of indexes.
	For Each idxRep In tblRep.Indexes

	' Ignore replication-related indexes:
	' s_Generation, s_GUID
	If Left(idxRep.Name, 2) <> "s_" Then

	' Ignore indices set as part of Relation Objects
	If Not idxRep.Foreign Then

	' Create an index with the same name.
	Set idxNew = tblNew.CreateIndex(idxRep.Name)

	' Set properties.
	idxNew.Clustered = idxRep.Clustered
	idxNew.IgnoreNulls = idxRep.IgnoreNulls
	idxNew.Primary = idxRep.Primary
	idxNew.Required = idxRep.Required
	idxNew.Unique = idxRep.Unique

	' Loop through the collection of index fields.
	For Each fldRep In idxRep.Fields
	' Create an index field with the same name.
	Set fldNew = idxNew.CreateField(fldRep.Name)
	' Set properties.
	fldNew.Attributes = fldRep.Attributes
	' Append the index field.
	idxNew.Fields.Append fldNew
	Next fldRep

	' Append the index to the table.
	tblNew.Indexes.Append idxNew
	End If
	End If
	Next idxRep

	' Append the table.
	dbNew.TableDefs.Append tblNew
	End If
	Next tblRep

	'********************
	Debug.Print "Copy Data"
	'********************
	' Loop through the list of table definitions.
	For Each tblRep In dbRep.TableDefs

	' Ignore system tables and _Confict tables.
	If Left(tblRep.Name, 4) <> "MSys" And _
	InStr(1, tblRep.Name, "_Conflict", vbTextCompare) = 0 Then

	' Open a recordset for the un-replicated table.
	Set rstNew = dbNew.OpenRecordset(tblRep.Name, dbOpenTable)
	' Open a recordset for the replicated table.
	Set rstRep = dbRep.OpenRecordset(tblRep.Name, dbOpenTable)

	' Continue if there are records.
	If Not rstRep.BOF Then

	' Move to the first record.
	rstRep.MoveFirst

	' Loop through all the replicated table records.
	Do Until rstRep.EOF
	' Add a record to the un-replicated table.
	rstNew.AddNew
	' For each field in the un-replicated table, set the value
	' to the value in the related field of the replicated table.
	For intC = 0 To rstNew.Fields.Count - 1
	rstNew.Fields(intC).Value = _
	rstRep.Fields(rstNew.Fields(intC).Name).Value
	Next
	' Update the un-replicated table.
	rstNew.Update
	' Move to the next replicated table record.
	rstRep.MoveNext
	Loop ' rstRep
	End If

	' Close the un-replicated recordset.
	rstNew.Close
	' Close the replicated recordset.
	rstRep.Close
	End If
	Next tblRep

	'********************
	Debug.Print "Copy Relationships"
	'********************
	' Loop through the collection of table relationships.
	For Each relRep In dbRep.Relations

	' Create a relation with the same name.
	Set relNew = dbNew.CreateRelation(relRep.Name, relRep.Table, _
	relRep.ForeignTable, relRep.Attributes)

	' Loop through the collection of relation fields.
	For Each fldRep In relRep.Fields

	' Append a relation field with the same name.
	relNew.Fields.Append relNew.CreateField(fldRep.Name)

	' Give the relation field the same foreign name.
	relNew.Fields(fldRep.Name).ForeignName = _
	relRep.Fields(fldRep.Name).ForeignName
	Next fldRep

	' Append the the relation to the database.
	dbNew.Relations.Append relNew
	Next relRep

	'********************
	Debug.Print "Copy Queries"
	'********************
	' Loop through the collection of query definitions.
	' We use this method rather than TransferDatabase action used below
	' because both tables and queries are listed in the Tables container.
	For Each qryRep In dbRep.QueryDefs

	' Create a query definition with the same name and SQL.
	Set qryNew = dbNew.CreateQueryDef(qryRep.Name, qryRep.SQL)

	' Set properties.
	qryNew.Connect = qryRep.Connect
	qryNew.MaxRecords = qryRep.MaxRecords
	qryNew.ReturnsRecords = qryRep.ReturnsRecords

	' Append the query definition to the database (NOT NECESSARY).
	' dbRep.QueryDefs.Append qryNew
	Next qryRep

	'********************
	Debug.Print "Copy Startup Options"
	'********************
	' Create an array of startup options to examine.
	avarSUOpt = Array( _
	"AllowBreakIntoCode", _
	"AllowBuiltInToolbars", _
	"AllowFullMenus", _
	"AllowShortcutMenus", _
	"AllowSpecialKeys", _
	"AllowToolbarChanges", _
	"AppIcon", _
	"AppTitle", _
	"StartupForm", _
	"StartupMenuBar", _
	"StartupShortcutMenuBar", _
	"StartupShowDBWindow", _
	"StartupShowStatusBar")

	' Handle errors in this section of code.
	On Error Resume Next

	' Loop through the array.
	For intC = 0 To UBound(avarSUOpt)

	' Get the name of the property from the array.
	strSUOpt = avarSUOpt(intC)

	' Clear and continue if there is an error.
	Err.Clear

	' Try to get the property in the replicated database.
	Set prpRep = dbRep.Properties(strSUOpt)

	If Err.Number = 0 Then
	' The property exists in the replicated database.
	' Get its Value and Type.
	varValue = prpRep.Value
	varType = prpRep.Type

	' Try to get the property in the un-replicated database.
	Set prpNew = dbNew.Properties(strSUOpt)

	If Err.Number = 0 Then
	' The property exists. Reset its value to the
	' replicated database value.
	prpNew.Value = varValue
	Else
	' The property does not exist yet. Create the property,
	' using the replicated database type and value, and
	' then append it to the database.
	Set prpNew = dbNew.CreateProperty(strSUOpt, varType, varValue)
	dbNew.Properties.Append prpNew
	End If
	Else
	' The property does not exist in the replicated
	' database, so ignore it.
	End If
	Next intC

	' Turn overall error handling back on.
	On Error GoTo Err_UnReplicate

	' Close the un-replicated database so that it can be opened
	' exclusively using GetObject.
	dbNew.Close

	' Get the Access application object for the un-replicated database.
	Set appNew = GetObject(varFileNew)
	appNew.Visible = False

	'********************
	Debug.Print "Import Forms"
	'********************
	' Loop through the collection of forms in the replicated database
	' and import each one. This automatically removes the replicated flag.
	For Each doc In dbRep.Containers("Forms").Documents
	appNew.DoCmd.TransferDatabase acImport, "Microsoft Access", _
	varFileRep, acForm, doc.Name, doc.Name
	Next doc

	'********************
	Debug.Print "Import Reports"
	'********************
	' Loop through the collection of reports in the replicated database
	' and import each one. This automatically removes the replicated flag.
	For Each doc In dbRep.Containers("Reports").Documents
	appNew.DoCmd.TransferDatabase acImport, "Microsoft Access", _
	varFileRep, acReport, doc.Name, doc.Name
	Next doc

	'********************
	Debug.Print "Import Modules"
	'********************
	' Loop through the collection of modules in the replicated database
	' and import each one. This automatically removes the replicated flag.
	For Each doc In dbRep.Containers("Modules").Documents
	appNew.DoCmd.TransferDatabase acImport, "Microsoft Access", _
	varFileRep, acModule, doc.Name, doc.Name
	Next doc

	'********************
	Debug.Print "Import Macros"
	'********************
	' Loop through the collection of macros in the replicated database
	' and import each one. This automatically removes the replicated flag.
	For Each doc In dbRep.Containers("Scripts").Documents
	appNew.DoCmd.TransferDatabase acImport, "Microsoft Access", _
	varFileRep, acMacro, doc.Name, doc.Name
	Next doc

	' Close the un-replicated database.
	appNew.Quit

	' Message the user.
	MsgBox "UnReplicate is complete."
	Debug.Print "Complete"

	UnReplicate = True

	Exit_UnReplicate:
	On Error Resume Next
	' Turn off the hourglass.
	DoCmd.Hourglass False

	' Clean up.
	Set fdlPick = Nothing

	Set idxRep = Nothing
	Set idxNew = Nothing
	Set fldRep = Nothing
	Set fldNew = Nothing
	Set tblRep = Nothing
	Set tblNew = Nothing

	rstRep.Close
	rstNew.Close
	Set rstRep = Nothing
	Set rstNew = Nothing

	Set relRep = Nothing
	Set relNew = Nothing

	Set qryRep = Nothing
	Set qryNew = Nothing

	Set prpRep = Nothing
	Set prpNew = Nothing

	dbRep.Close
	dbNew.Close
	Set dbRep = Nothing
	Set dbNew = Nothing

	Set doc = Nothing
	appNew.Quit
	Set appNew = Nothing

	Exit Function

	Err_UnReplicate:
	MsgBox Err.Number & " " & Err.Description, vbCritical, "UnReplicate()"
	UnReplicate = False
	Resume Exit_UnReplicate:

	End Function