Freelancer Developer, Database Expert, Contract Jobs – iLoveCoding

Option Compare Database
Option Explicit
 
'Set the below variable to TRUE
'When you are done with testing
'Basically testing mode will print
'the names of all the databases
'you are going to merge

Const bTest = False
 
Sub Merge()
 
    'Copyright © iLoveCoding, 2010
    'Web: http://www.iLoveCoding.co.uk

    'The Merege() is a function that merges
    'records from multiple MS Access databases
    'into a consolidated one provided that the
    'structure of all databases are exactly same.
    '
    'This function assumes that there are
    'no relationships defined among the tables.
    'Which is typically the scenario when an
    'MS Access database is used in an Intranet or
    'Web application.

    'However properly altering the order of the
    'dbfiles() initialization one can easily
    'address the issue of relationships and
    'data integrity among tables

    On Error GoTo errhand
    Dim appPath$
    '----------------------------------------------
    'Change the below number to number of databases
    'you are going to merge
    '----------------------------------------------
    Const ndb = 22
    Dim dbfiles$(2 To ndb)
    Dim i%
    'ANA.mdb
    '----------------------------------------------
    'Array of the database file names without path
    'Copy this code into a module of the first database
    'The first database is going to be the consolidated
    'capturing the records from all other databases.
    'The first database name is not present here
    'That is why the index starts with 2.
    '----------------------------------------------
    dbfiles(2) = "second.mdb" '<= change the file name
    dbfiles(3) = "third.mdb"
    dbfiles(4) = "fourth.mdb"
    '
    'similarly initialize other files
    '
    dbfiles(10) = "tenth.mdb"
    '----------------------------------------------
    ' The databases should be copied to the same
    ' folder of the first database
    '----------------------------------------------
    appPath = CurrentProject.Path
    For i = 2 To ndb
        Dim dbpath$, db As Database
        dbpath = appPath & "\" & dbfiles(i)
        Set db = OpenDatabase(dbpath)
        Dim tbl As TableDef, j%
        For j = 0 To db.TableDefs.Count - 1
            DoEvents
            Set tbl = db.TableDefs(j)
            If tbl.Attributes = 0 Then
                If bTest Then
                    Debug.Print tbl.Name
                Else
                    DoCmd.TransferDatabase acLink, "Microsoft Access", _
                    dbpath, acTable, tbl.Name, tbl.Name & "_Linked", False
                    Dim sql$
                    sql = "INSERT INTO [" & tbl.Name & "] SELECT * FROM [" & _
                    tbl.Name & "_Linked" & "]"
                    DoCmd.RunSQL sql
                    DoCmd.DeleteObject acTable, tbl.Name & "_Linked"
                End If
            End If
        Next j
        Debug.Print dbfiles(i)
    Next i
    Exit Sub
errhand:
    MsgBox Err.Description
End Sub