Function Link_Tables()
On Error GoTo Link_Tables_Err_Click
Dim dbs As Database
Dim tbfNew As TableDef
Dim CurrFile As String
Dim TableName As String
Dim TableNameArray(5) As String
Dim MyCount As Integer
'set database and start file
Set dbs = CurrentDb()
CurrFile = Dir("L:\Class Data Archive\Archive\*.mdb")
'do while still files to link
Do While CurrFile <> ""
TableName = "tbl_" & Left(CurrFile, InStr(CurrFile, ".") - 1)
'create new linked table
Set tbfNew = dbs.CreateTableDef(TableName)
'connect table and set name
With tbfNew
.Connect = ";database=L:\Class Data Archive\Archive\" & CurrFile
.SourceTableName = TableName
End With
'update tabledefs
dbs.TableDefs.Append tbfNew
'set to next file
CurrFile = Dir
'repeat
Loop
Create_Query:
'once tables linked create UNION query
Dim qdf As QueryDef
Dim strSQL As String
'initialise count
MyCount = 1
'populate array
With dbs
For Each tdf In .TableDefs
If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 4) <> "~TMP" Then
TableNameArray(MyCount) = tdf.Name
MyCount = MyCount + 1
End If
Next
End With
'delete existing query first
DoCmd.DeleteObject acQuery, "qry_Class_Data_UNION"
'Dynamic SQL string depending on contents of array
strSQL = "SELECT " & TableNameArray(1) & ".*"
strSQL = strSQL & " FROM " & TableNameArray(1) & ""
strSQL = strSQL & " WHERE " & TableNameArray(1) & ".[Report Date] >= (forms!Switchboard!txtstartdate) and " & TableNameArray(1) & ".[Report Date] <=(forms!switchboard!txtenddate)"
If TableNameArray(2) <> "" Then
strSQL = strSQL & " UNION SELECT " & TableNameArray(2) & ".*"
strSQL = strSQL & " FROM " & TableNameArray(2) & ""
strSQL = strSQL & " WHERE " & TableNameArray(2) & ".[Report Date] >= (forms!Switchboard!txtstartdate) and " & TableNameArray(2) & ".[Report Date] <=(forms!switchboard!txtenddate)"
If TableNameArray(3) <> "" Then
strSQL = strSQL & " UNION SELECT " & TableNameArray(3) & ".*"
strSQL = strSQL & " FROM " & TableNameArray(3) & ""
strSQL = strSQL & " WHERE " & TableNameArray(3) & ".[Report Date] >= (forms!Switchboard!txtstartdate) and " & TableNameArray(3) & ".[Report Date] <=(forms!switchboard!txtenddate)"
Else
strSQL = strSQL & ";"
End If
Else
strSQL = strSQL & ";"
End If
'create query
Set qdf = dbs.CreateQueryDef("qry_Class_Data_UNION", strSQL)
Link_Tables_Exit_Click:
Exit Function
Link_Tables_Err_Click:
'table already exists
If Err.Number = 3012 Then
Resume Next
Else: MsgBox Err.Number & " " & Err.Description, vbOKOnly + vbCritical, "Error!"
Resume Link_Tables_Exit_Click
End If
End Function