This VBA function copies or imports all the objects and database startup properties from a Microsoft Access replicated database into an un-replicated database. It removes tablename_Conflict tables and removes replication-related fields like s_GUID, etc.
Background:
The Microsoft support site describes some methods that can be used change a replicated MS Access database to a normal database:
Access 95, Access 97 wizards and manual method description –
http://support.microsoft.com/kb/q153526/
Access 2000 – Access 2003 manual method –
http://support.microsoft.com/kb/290052/
Not only do the tables need to recreated, but there is a list of other items to restore:
- Non-default references (in code)
- Security of the database objects
- Table indexes and relationships
- Table properties
- Validation rules
- Database properties (like the startup options)
- Forms, Reports, Modules, Macros, and Pages
Other than the non-default references, database object security, and the import of Pages, the code below automatically takes care of the whole list.
How to use:
- Create a blank new database. In my version of Windows, I just did a right-click in the folder, selected the New option, then Microsoft Office Access Database. As soon as the file appears, name it something useful.
- The code is meant to run in a database separate from the replicated or new database. Import the code module (which you can download below) or create a new code module and copy the code into it.
- In the database with the code module, use the Tools, References menu option to set some references. The FileDialog object requires a reference to a Microsoft Office Object Library (10 [Access 2002] or later). And because the code uses DOA, it requires a reference to Microsoft DAO Object Library, or for Access 2007 and later, the Microsoft Office Access database engine Object Library.
- Run the UnReplicate() function.
- When the first browser box appears, select the replicated database. When the second browser box appears, select the new database.
- The hourglass will appear, and depending upon how much data is in your tables and the speed of your processor, it may take several minutes before the “UnReplicate is complete” message appears.
- If the new database has any code modules, set non-default dll references by using the Tools, References menu option. When you get them all properly selected, you should be able to compile without an error.
- If you need to establish database object security, finish the job with that.
- The code works best when it is called from a database separate from the replicated and new databases. This is because the TransferDatabase actions that are used to import the Forms, Reports, etc., require the new database to be opened exclusively. That is also why the dbNew database is closed before the TransferDatabase actions are called using the appNew object.
- Because of the reference to the Microsoft Office Object Library, the file picker part of the code will only work if Access 2002 or later is installed. You can replace this with some common dialog code for versions before that.
- The database properties that are copied over relate to a select list of startup options. You can find the list where the avarSUOpt array is created. Feel free to add or subtract from the list.
- If you need to import Pages as well, add a section similar to the Import Macros section and use the “Pages” container.
Code:
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.1 ' Copyright © 2013 Extra Mile Data, www.extramiledata.com. ' For questions or issues, please contact [email protected]. ' 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
Hi
I am getting a 13 type mismatch error on the line
For Each qryRep In dbRep.QueryDefs
any thoughts?
MS Access 2007
pol,
I would check these things:
(1) You must run the code in a database separate from the old database and the new database.
(2) You must have references to the Microsoft DAO Object Library, or for Access 2007 and later, the Microsoft Office Access database engine Object Library.
Thanks
I did run in separate db from old and new. Access 2007 (Win7, 64bit)
MS Access 12 db engine object library referenced. Also VBA, MS Access 12 object library, OLE automation, MS Office 12 Object Library.
I added debug.print after line
For Each qryRep In dbRep.QueryDefs
Debug.Print qryRep
but it doesn’t make it that far, implying it doesn’t recognise the type qryRep which has been defined as DAO.QueryDef
I don’t see any problem here. Access 2007 is happy with DAO.TableDef etc.
I have noticed in other code I have that previously (MS Acc 2003) working modules fail on e.g.
Set rst = dbs.OpenRecordset(str)
(str = properly functioning query) when a condition is included in query and I have had to modify the actual SQL WHERE statement to get it to work.I am going to hand export the queries and use you code for everything else. Hope it works.
bye
Pol
Pol,
I’ve not seen this issue while running this code – best of luck. One last option to try might be to reference the Microsoft DOA 3.6 Object library also, even though you shouldn’t need to (in theory). Access 2007 is OK with having both referenced.
Watch out for the code eliminating replication fields. It removed some valid data fields from my tables that happened to have the characters “s_” in the name. Changed the
instr
to a left comparison so only fields beginning with those identifiers are excluded.Kat, great catch! At your suggestion, I made changes to the code in several places where I knew I was looking for specific values at the beginning of the field, index, or table name.
So glad you created this! Thank you! I got an error at the line: For Each idxRep In tblRep.Indexes, saying “Could not read definitions; no read definitions permission for table or query {name of my table}.” I forced it to loop to another table and got the same result. Do you have any idea why I wouldn’t have those permissions or how to get them back? I’m on a standalone PC and I created the database. I did run the security wizard at one point, but didn’t put any restrictions on anything.
I think I got it handled. I pulled all of the objects into a new .accdb database to remove any possible security and ran your code on that one to get rid of the extra replication columns which worked!
Worked like a dream, my database is now half the size it was before and those annoying replication fields are all gone.
It didn’t want to work in Access 2007 so I imported the tables into an .mdb file then ran this tool on them and imported them back. No noticeable unwanted side effects so far… thank you very very much!
Am trying to unreplicate an access 2000 file format database in order to get rid of tombstone and replica list. The problem is I cant open the replicated db ( at the first dialogue box) reason being that I do not have permission… contact system administrator…
Yes I use user level security but am the administrator. Somebody please help.
Hi, not sure if you can help me. I am getting 3012 Object ‘MsysNavPaneGroupCategoriesMSysNavPaneGroups’ already exists. Any ideas?
I’m getting a compile error ‘user defined type not defined’. At (fdlPick As Office.FileDialog) I’ve checked that the references are on. Not sure what to do. Thanks a lot.
A.Hagi, please check the following, which are necessary to run the code as it is above:
(1) You must be using Access 2002 or later.
(2) You must have the Microsoft Office Object library referenced. This is NOT check marked by default and it is NOT THE SAME as the Access library. For example, if I were using Access 2007, I would go to Tools, References, and then scroll down to check mark “Microsoft Office 12.0 Object Library”. That is the library that provides the Office.FileDialog object.
I’m using access 2003 and I’ve made sure a few times that the references are checked. Still the same problem though.
To be more precise I’ve got “Microsoft access 11.0 object library” checked and “Microsoft DAO 3.6 object library”
A.Hagi, you must also check mark “Microsoft OFFICE 11.0 Object Library”. That is a different library than Microsoft Access 11.0 Object Library.
guys, i just want to point out something.
you must set your access application setting for open last database to unchecked. if access automatically opens the last database when you open the application, the getobject line of code after checking for all the intCs in the “Copy Startup Options” will NOT work. you will get an automation error.
other than that, i just want to say a very very big thank you to Extra Mile Data for writing this fantastic piece of code to share with all of us.
THANK YOU EXTRA MILE DATA!!!!!! i, and i believe all of us who have used your module really appreciate all your great effort into this!! = ))
Isaac, great catch. And you are welcome. How many times a day do I find and use an Access or VBA solution from a forum post or a web site I found in an internet search? Many, many. I’m glad I can pass back just a portion of that help.
Thanks Extra Mile Data ! Worked like a charm.
Thanks. That got me out of a lot of trouble. See also later posts in
http://answers.microsoft.com/en-us/office/forum/office_2007-access/how-do-i-link-library-owc10dll-in-a-new-version/f8d71d90-9b22-418b-9e41-71fe16d7a5da which documents my problem and your part in the solution
There are 3 places where you have a in the code that don’t come through in the listing – I think you need %lt; and %gt;
The code module also says it’s not completely downloaded, at least on my win7 machine
Jeff, I fixed the problems and altered one of the lines. The download file should also reflect the changes. Thanks!
I got an error once it tried to create a Decimal field, which according to this you can’t do in DAO 🙁
http://stackoverflow.com/questions/1630526/how-to-create-a-decimal-field-in-msaccess-using-dao
ADO implementation, anyone? 🙂
Jeff,
This page provides the ADOX equivalent for the Decimal type field, which would be adNumeric:
http://allenbrowne.com/ser-49.html
I suppose you could ignore the Decimal fields until after the DAO section is complete, and then add the Decimal fields using ADOX. But then you would have to make sure that you changed the field order if you wanted to keep the Decimal field in the old field order.
The link you provided above suggested that you change the Decimal field to Currency and then format it the way that you want. I have one customer that did all his number fields in Currency.
I think for now, since using Decimal field types is typically rare for Access applications, I will leave the code as it is.