This will require extensive modification
But it does loop through db's in a directory and grab the name and data from each db and dump into a master db
Sub MergeLCP_DBs()
On Error GoTo HandleErr
'Move through the directory structure reading each database name into a table.
'Retrieve information from each table to merge into one database.
Dim FileNum As Integer
Dim sFile, sSourcePath, sDestPath As String
Dim db As DAO.Database
Dim rsImportedDatabases As DAO.Recordset
Set db = CurrentDb
Set rsImportedDatabases = db.OpenRecordset("SELECT * FROM tblLCP_GetDatabaseNames WHERE [Imported]= False", dbOpenDynaset)
'Location on Local Drive
sFile = Dir("C:\Databases\YEProcessing\LCP_Processing\DBsRecvd\*.mdb")
sSourcePath = "C:\Databases\YEProcessing\LCP_Processing\DBsRecvd\"
sDestPath = "C:\Databases\YEProcessing\LCP_Processing\DBsImported\"
Do While Not IsEmpty(sFile) And sFile <> ""
'Insert the database name into the table
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblLCP_GetDatabaseNames (DBName) VALUES ('" _
& sFile & "')"
DoCmd.SetWarnings True
'Copy tables from external database
DoCmd.SetWarnings False
'-------------MgdRev-------
'Make temp table based on external database
DoCmd.RunSQL "SELECT tblAccount.SAPID AS LCP_SAPID, tblpd.[LNAME]& ', ' & tblpd.[FNAME] AS LCPNAME," _
& " tblLeadClients.ClientNumber, tblLeadClients.ClientName, " _
& " tblMgdRev.MgdRevId,tblMgdRevCredit.PartnerDirector, tblMgdRevCredit.PDAmount INTO tblLCP_MgdRevTemp" _
& " FROM (tblMgdRev INNER JOIN tblMgdRevCredit ON tblMgdRev.MgdRevID = tblMgdRevCredit.MgdRevID) INNER JOIN " _
& " ((tblAccount INNER JOIN tblPD ON tblAccount.SAPID = tblPD.SAPID) " _
& " INNER JOIN tblLeadClients ON tblAccount.ClientNumber = tblLeadClients.ClientNumber) ON tblMgdRev.AcctID = tblAccount.AcctID " _
& " IN '" & sSourcePath & sFile & "'" _
& " GROUP BY tblAccount.SAPID, tblpd.[LNAME] & ', ' & tblpd.[FNAME], tblLeadClients.ClientNumber, " _
& " tblLeadClients.ClientName, tblMgdRev.MgdRevId,tblMgdRevCredit.PartnerDirector, tblMgdRevCredit.PDAmount"
'Append records from temp table to table merging records from each database
DoCmd.OpenQuery "qryLCP_Append_MgdRev"
'Add the database name to the records
DoCmd.RunSQL "UPDATE tblLCP_Merged_MgdRev SET DBName= '" & sFile _
& "' WHERE DBName IS NULL"
'---------------PrimarySales--------------
'Make temp table based on external database
DoCmd.RunSQL "SELECT tblAccount.SAPID AS LCP_SAPID, tblpd.[LNAME] & ', ' & tblpd.[FNAME] AS LCPNAME, " _
& " tblsales.salesid,tblLeadClients.ClientNumber, tblLeadClients.ClientName, tblPrimarySalesCredit.PrimaryPD, " _
& "tblSales.Amount INTO tblLCP_PrimarySalesTemp" _
& " FROM (tblPrimarySalesCredit INNER JOIN tblSales ON tblPrimarySalesCredit.SalesID = tblSales.SalesID)" _
& " INNER JOIN ((tblAccount INNER JOIN tblPD ON tblAccount.SAPID = tblPD.SAPID) " _
& " INNER JOIN tblLeadClients ON tblAccount.ClientNumber = tblLeadClients.ClientNumber) " _
& " ON tblSales.AcctID = tblAccount.AcctID " _
& " IN '" & sSourcePath & sFile & "'" _
& " GROUP BY tblAccount.SAPID, tblpd.[LNAME] & ', ' & tblpd.[FNAME], tblSales.SalesId,tblLeadClients.ClientNumber," _
& " tblLeadClients.ClientName, tblPrimarySalesCredit.PrimaryPD, tblSales.Amount"
'Append records from temp table to table merging records from each database
DoCmd.OpenQuery "qryLCP_Append_PrimarySales"
'Add the database name to the records
DoCmd.RunSQL "UPDATE tblLCP_Merged_PrimarySales SET DBName= '" & sFile _
& "' WHERE DBName IS NULL"
'--------------SupportSales------------
'Make temp table based on external database
DoCmd.RunSQL "SELECT tblAccount.SAPID AS LCP_SAPID, tblpd.[LNAME] & ', ' & tblpd.[FNAME] AS LCPNAME," _
& " tblSales.SalesId,tblLeadClients.ClientNumber, tblLeadClients.ClientName, tblSupportSalesCredit.SupportPD, " _
& "tblSales.Amount INTO tblLCP_SupportSalesTemp" _
& " FROM (((tblAccount INNER JOIN tblPD ON tblAccount.SAPID = tblPD.SAPID) " _
& " INNER JOIN tblLeadClients ON tblAccount.ClientNumber = tblLeadClients.ClientNumber)" _
& " INNER JOIN tblSales ON tblAccount.AcctID = tblSales.AcctID) " _
& " INNER JOIN tblSupportSalesCredit ON tblSales.SalesID = tblSupportSalesCredit.SalesID " _
& " IN '" & sSourcePath & sFile & "'" _
& " GROUP BY tblAccount.SAPID, tblpd.[LNAME] & ', '& tblpd.[FNAME], " _
& " tblSales.SalesId,tblLeadClients.ClientNumber, tblLeadClients.ClientName, " _
& " tblSupportSalesCredit.SupportPD, tblSales.Amount"
'Append records from temp table to table merging records from each database
DoCmd.OpenQuery "qryLCP_Append_SupportSales"
'Add the database name to the records
DoCmd.RunSQL "UPDATE tblLCP_Merged_SupportSales SET DBName= '" & sFile _
& "' WHERE DBName IS NULL"
DoCmd.SetWarnings False
'Delete temp tables
DoCmd.DeleteObject acTable, "tblLCP_MgdRevTemp"
DoCmd.DeleteObject acTable, "tblLCP_PrimarySalesTemp"
DoCmd.DeleteObject acTable, "tblLCP_SupportSalesTemp"
'Record in the table that the database has been imported
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE tblLCP_GetDatabaseNames SET Imported=True,Importdate= #" & Now() _
& "# WHERE DBName= '" & sFile & "'"
DoCmd.SetWarnings True
'Place a copy of the file in the completed folder and remove the copy from the original location
FileCopy sSourcePath & sFile, sDestPath & sFile
Kill sSourcePath & sFile
'Move to next file
sFile = Dir
Loop
rsImportedDatabases.Close
Set rsImportedDatabases = Nothing
MsgBox "Process Completed", vbInformation
Exit Sub
ExitHere:
Exit Sub
' Error handling block added by Error Handler Add-In. DO NOT EDIT this block of code.
' Automatic error handler last updated at 04-27-2005 11:39:03 'ErrorHandler:$$D=04-27-2005 'ErrorHandler:$$T=11:39:03
HandleErr:
Select Case Err.Number
Case 3078
MsgBox "Import of table in " & sFile & " failed."
Resume Next
Exit Sub
Case Else
Resume Next
'MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "General.GetDatabaseName" 'ErrorHandler:$$N=General.GetDatabaseName
End Select
' End Error handling block.
End Sub
