append tables with non matched fields?

[meacho]

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]

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 )

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