Import Multiple Access Databases into Single Master Database
We have a proprietary inventory program that archives data weekly into separate .mdb files, all contained in a single directory.
We'd like to have this data available in a single access (or MySQL) database for querying from Excel so that we can create reports.
Is there a way, preferably automatically and completely automated, to accomplish this? As of right now we need to manually import the new access database weekly.
The tables and structure are always the same, and there is never repeating data.
We'd like to have this data available in a single access (or MySQL) database for querying from Excel so that we can create reports.
Is there a way, preferably automatically and completely automated, to accomplish this? As of right now we need to manually import the new access database weekly.
The tables and structure are always the same, and there is never repeating data.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Got it to work as I needed.
The script is in the code below for anyone interested.
The script is in the code below for anyone interested.
Option Compare Database
Option Explicit
Public Sub ImportMDB(spath As String, lst As ListBox)
Dim Db As Database ' DAO Vars
'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
'Set references by Clicking Tools and Then References in the Code View window
' Imports all tables in all external MS Access Databases (.mdb)
' The Code assumes the Start path is the current database path
' Accepts
' spath: "\" or folder name and "\"
' FieldName: Name of the field to create in the table
' Returns True on success, false otherwise.
'USAGE: ImportMDB "spath"
' On Error GoTo errhandler 'If there is an error capture the error.
Dim objFS As Object, objFolder As Object
Dim objFiles As Object, objF1 As Object
Dim strPath As String, strTableName As String, tblname As String
Dim strSql As String, mpath As String
Dim FileLen As Integer, i As Integer, X As Integer, n As Integer
'Did we forget a "\" before we insert the file name
If Len(spath) > 0 Then
If Left(spath, 1) <> "\" Then
spath = "\" & spath
If Right(spath, 1) <> "\" Then
spath = spath & "\"
End If
End If
Else
spath = "\"
End If
'Set import Path
strPath = CurrentProject.Path & spath
'Ensure we have not made double "\" anywhere.
strPath = Replace(strPath, "\\", "\")
'Set Scripting Variables to retrieve files
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(strPath)
Set objFiles = objFolder.files
Set Db = CurrentDb()
'Loop through the files
For Each objF1 In objFiles
'Check for our file extension mdb and
'Check our file against our current mdb so we do not re-import tables
If Right(objF1.Name, 3) = "mdb" And CurrentDb.Name <> strPath & objF1.Name Then
'for Access 2007: Delete above line Uncomment following line
'If Right(objF1.Name, 5) = "accdb" And CurrentDb.Name <> strPath & objF1.Name Then
FileLen = Len(objF1.Name)
'Set the Table Name to import as using the file name
'Without the file extension
strTableName = Left(objF1.Name, FileLen - 4)
'For Access2007: Delete above line Uncomment following line
'strTableName = Left(objF1.Name, FileLen - 6)
'Finalize Path
mpath = strPath & objF1.Name
'Grab external Database's Tables
'and add to Listbox
GetAllExternalTables strPath, objF1.Name, lst
With lst
'Loop through the Tables in the Listbox
For i = 0 To .ListCount - 1
'set table name
tblname = .Column(0, i)
'Ensure we have not done this already
If ifTableExists(strTableName & "_" & tblname) = False Then
'Ensure the External table does indeed exist
If ifExternalTableExists(tblname, mpath) Then
'Import the MS Access Table
'Create the SQL Code from our String Values
strSql = "INSERT INTO [" & tblname & _
"] SELECT [" & tblname & "].* FROM [" & tblname & "] IN '" & mpath & "'[MS ACCESS;];"
'Print the SQL for testing
Debug.Print strSql
Db.Execute strSql
End If
End If
Next i
End With
End If
Next objF1
ExitHere:
'close out
Set objF1 = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFS = Nothing
Db.Close
Set Db = Nothing
Exit Sub
errhandler:
'Trap any errors
With Err
MsgBox "Error " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, "ImportMDB"
End With
Resume ExitHere
End Sub
Public Sub GetAllExternalTables(spath As String, strDB As String, lst As ListBox)
'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
'Set references by Clicking Tools and Then References in the Code View window
' Returns all Table Names that exist in an External MS Access Database.
' Accepts
' spath: Path to External MS Access Database
' Returns All your Table Names in an External MS Access Database
' and excludes tables with MSys and ~
'USAGE: GetAllExternalTables "spath"
On Error GoTo errhandler 'Capture any errors.
Dim i As Integer, X As Integer, numTables As Integer, tabName As String, strPath As String, strExtTblname As String
If Len(spath) > 0 Then
If Left(spath, 1) <> "\" Then
'spath = "\" & spath
If Right(spath, 1) <> "\" Then
spath = spath & "\"
End If
End If
Else
spath = "\"
End If
'Set import Path
'strPath = CurrentProject.Path & spath
strPath = spath
'Ensure we have not made double "\" anywhere.
strPath = Replace(strPath, "\\", "\")
'complete the path string
strPath = strPath & strDB
' Loop through all the Tables Clear List
With lst
.RowSourceType = "Value List"
For X = 0 To .ListCount - 1
If .ListCount - 1 > 0 Then
If IsNull(.Column(0, X)) = False Then
.RemoveItem .Column(0, X)
End If
If IsNull(.Column(0, X)) = True Then X = 0
Else
.RemoveItem .Column(0, 0)
Exit For
End If
Next
End With
'Get Number of External Tables
numTables = DBEngine.Workspaces(0).OpenDatabase(strPath).TableDefs.Count - 1
For i = 0 To numTables
'Set our Table Name string
tabName = LCase(DBEngine.Workspaces(0).OpenDatabase(strPath).TableDefs(i).Name)
strExtTblname = DBEngine.Workspaces(0).OpenDatabase(strPath).TableDefs(i).Name
'Check for mssys and ~ prefixed tables and skip them
If InStr(1, tabName, "msys") = False And _
InStr(1, tabName, "~") = False Then
'display the tables using the Object
'to keep User Case sensitive Names
lst.AddItem Chr(34) & strExtTblname & Chr(34)
End If
Next
Exit Sub
errhandler: 'Capture any Errors
With Err
MsgBox "Error " & .Number & vbCrLf & .Description, _
vbOKOnly Or vbCritical, "GetAllExternalTables"
End With
Resume Next
End Sub
Function ifExternalTableExists(TableName As String, spath As String) As Boolean
Dim rs As Recordset, Db As Database ' DAO Vars
Dim strSql As String
'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
'Set references by Clicking Tools and Then References in the Code View window
'Checks if Table exists in external MS Access Database.
'USAGE: ifExternalTableExists "TABLENAME", "spath"
On Error GoTo NoTable 'If there is no table capture the error.
Set Db = CurrentDb()
'If Table is there open it
strSql = "SELECT * FROM [" & TableName & _
"] IN '" & spath & "'[MS ACCESS;];"
Set rs = Db.OpenRecordset(strSql)
ifExternalTableExists = True
rs.Close
Db.Close
Exit Function
NoTable:
'If table is not there close out and set function to false
Set rs = Nothing
Db.Close
Set Db = Nothing
ifExternalTableExists = False
Exit Function
End Function
Function ifTableExists(TableName As String) As Boolean
Dim rs As Recordset, Db As Database ' DAO Vars
'References: Microsoft Access 11.0 Object Library, Microsoft DAO 3.6 Object Library
'Set references by Clicking Tools and Then References in the Code View window
'Checks if Table exists.
'USAGE: ifTableExists "TABLENAME"
On Error GoTo NoTable 'If there is no table capture the error.
Set Db = CurrentDb()
'If Table is there open it
Set rs = Db.OpenRecordset("Select * from [" & TableName & "];")
ifTableExists = True
rs.Close
Db.Close
Exit Function
NoTable:
'If table is not there close out and set function to false
Set rs = Nothing
Db.Close
Set Db = Nothing
ifTableExists = False
Exit Function
End FunctionASKER
Oh, and the original code, that I modified and pasted above, came from:
http://www.eraserve.com/tu
http://www.eraserve.com/tu
ASKER
The only problem I am having with it is that it's appending the name of the access database to the table name, instead of combining all records into the similar table name.
For example I now have 'ARC39484_Stored' and 'ARC39485_Stored' instead of a singled 'Stored' table; I'll look through the code to see it's appending the database name by design.
If anyone knows off the top how to combine all records into the single table that'd be great.