this is one approach (among many). However, it has a different goal then precisely what you stated - it is to get everything in one table. Then you should be able to use the data however you want with regular queries or import to Excel or whatever. If it doesn't work for you then it might spark other ideas instead.
Clearly, just setting up a loop with transferspreadsheet or using ADO to move data around is another major option.
An ETL Process in Three Parts:
1) preconditions:
a) a new database with two table , one is called mesval, the other is called MesVal_SRC_Tables
The MesVal table has two extra columns. The first column is called SeqNum and is an autonumber primary key. The second column is called SRC and is a Short Text column. All the other columns will be the same as your other MesVal tables.. The MesVal_SRC_Tables is defined as follows:
MesVal_SRC_Tables: (ID autonumber primary key, SRC short text, SRC_Path short text, SRC_Name short text, DateCreated date/time)
b) The folder with all the databases in it has nothing but the databases you want to import in it
c) the new database will be in a different folder from the other databases you are importing
2) General strategy:
a) We will import all of the other tables into one table
b) We will first create an append query for each other table
c) then we will run the append queries which append from the other databases into the single table.
d) In general we are using a remote query for each append action:
insert into MesVal ... select ... from table ... in database
e) One plus is that it after part B is done you can test these and see if it is all working (put the append query in design view and run the View command to see the results without actually appending anything.
f) Important! the
MesVal_SRC_Tables table is an index to tie the querynames back to the filenames of the original database. You can use this in joins or do an update/replace to get the original database names back. I used this because I don't have the names of all your database and don't know if they would cause problems in my code or not. If you want you could try to use the database names as query names (but which generally I wouldn't recommend anyway).
3) Caveats:
a) Short Text fields mean that database paths and names can only take up 255 characters or less
b) Code is optimistic. Everything is expected to be clean, consistent data. Any errors will probably result in a crash.
4) Code to make it all happen goes in a public module:
Code:
Sub CreateQueries()
Dim DBs As VBA.Collection
Dim vItem As Variant
Dim qdf As QueryDef
Dim i As Long
Dim s As String
Dim t As String
Dim fso As Object '//Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set DBs = GetDBs
For Each vItem In DBs
'//A unique name for the query
i = i + 1
s = "000000" & i
s = "XTMP24" & Right(s, 4)
t = "INSERT INTO MesVal SELECT '" & s & "' as SRC, Date() as DateCreated, MesVal.* FROM MesVal in '" & vItem & "'"
Set qdf = CurrentDb.CreateQueryDef(s, t)
'//Save a record to associate the query with its source
DoCmd.SetWarnings False
t = "insert into MesVal_SRC_Tables (SRC, SRC_Path, SRC_Name) values ('" & s & "', '" & vItem & "','" & fso.GetFileName(vItem) & "')"
DoCmd.RunSQL t
DoCmd.SetWarnings True
Next
End Sub
Sub RunQueries()
Dim col As VBA.Collection
Dim rs As DAO.Recordset
Dim vItem As Variant
'//Get the Queries
Set col = New VBA.Collection
Set rs = CurrentDb.OpenRecordset("select distinct SRC from MesVal_SRC_Tables", dbOpenForwardOnly)
If Not rs.EOF Then
Do While Not rs.EOF
col.Add rs.Fields("SRC").Value
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
'//Run the Queries
For Each vItem In col
DoCmd.SetWarnings False
Debug.Print vItem
DoCmd.OpenQuery vItem
DoCmd.SetWarnings True
Next
End Subxx
Function GetDBs() As VBA.Collection
Dim fso As Object '//Scripting.FileSystemObject
Dim fldr As Object '//Scripting.Folder
Dim f As Object '//Scripting.File
Dim col As VBA.Collection
Set col = New VBA.Collection
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\myTemp\Test4")
For Each f In fldr.Files
If fso.GetExtensionName(f.Path) = "accdb" Then
col.Add f.Path
End If
Next f
Set GetDBs = col
End Function
