View Full Version : append tables with non matched fields?


meacho
11-13-2007, 03:42 AM
i'm trying to append 5 tables into one , but... although the majority of the fields are the same for each table in each tabel there are a few fields not found in the other tables. to add to the problems i dont know what the name s of these additional columns will be, the will change quite frequently.



so is there any way of appending the tables keeping all the fields abviously inserting "null" or 0 into the blanks created on each record?


help please!!
thanks

YevS
11-13-2007, 07:21 AM
Well, something like this is not simple to do and requires some coding. First you will want to get all the fields (or columns) and stick it into one big table. Then you want to append to that table.

I wrote a bit of code that might help you, but I havent fully tested it yet (that would be your task :D )



Private Function RSLoop(tblName As String)

Dim rs, rsFields As Recordset
Dim db As Database
Dim fldLoop As Field

Set db = CurrentDb
Set rs = db.OpenRecordset(tblName)

'create a table called "Fields" to use this with a FieldID, FieldType & FieldSize fields
Set rsFields = db.OpenRecordset("tblFields", dbOpenDynaset)

For Each fldLoop In db.TableDefs(tblName).Fields

With rsFields

.FindFirst ("FieldID = '" & fldLoop.Name & "'")
If .NoMatch Then
.AddNew
!FieldID = fldLoop.Name
!FieldType = FieldType(fldLoop.Type)
!FieldSize = fldLoop.Size
'optional
!FieldRequired = IIf(fldLoop.Required, "Not Null", "")
.Update

End With

Next fldLoop


End Function

Private Function MkTableQ()

Dim rsFields As Recordset
Dim db As Database
Dim strMkTableQ As String

Set db = CurrentDb
Set rsFields = db.OpenRecordset("tblFields")

strMkTableQ = "create table MyBigFatTable ("

With rsFields
.MoveLast
.MoveFirst
If .RecordCount > 0 Then
Do Until .EOF

strMkTableQ = strMkTableQ & !FieldID & " " & !FieldType & "(" & !FieldSize & ") " & !FieldRequired
.MoveNext
If Not .EOF Then
strMkTableQ = strMkTableQ & ", "
Else
strMkTableQ = strMkTableQ & "; "
End If

Loop

DoCmd.RunSQL strMkTableQ

End Function

Private Function AppendQueries(tblName As String)

Dim AppendQ As String
'not sure if this bit works, dont have the time to test it
AppendQ = ""
AppendQ = "INSERT INTO MyBigFatTable SELECT " & tblName & ".* FROM " & tblName & ";"

DoCmd.RunSQL AppendQ

End Function


Private Sub Test_Click()

'place this sub on some button
RSLoop ("Table1")
RSLoop ("Table2")
RSLoop ("Table3")
RSLoop ("Table4")
RSLoop ("Table5")

'might need to make the table name a bit more dynamic
'or for user to pick
MkTableQ

AppendQueries ("Table1")
AppendQueries ("Table2")
AppendQueries ("Table3")
AppendQueries ("Table4")
AppendQueries ("Table5")

End Sub
Function FieldType(intType As Integer) As String

Select Case intType
Case dbBoolean
FieldType = "Boolean"
Case dbByte
FieldType = "Byte"
Case dbInteger
FieldType = "Integer"
Case dbLong
FieldType = "Long"
Case dbCurrency
FieldType = "Currency"
Case dbSingle
FieldType = "Single"
Case dbDouble
FieldType = "Double"
Case dbDate
FieldType = "Date"
Case dbText
FieldType = "Text"
Case dbLongBinary
FieldType = "LongBinary"
Case dbMemo
FieldType = "Memo"
Case dbGUID
FieldType = "GUID"
End Select

End Function