Import data according to the order of table relationships

I am trying to create a generic VBA import function in an access database. (I will link external tables of a similar database and then import their data into local tables.)

First, the function needs to get a list of tables in the local database, sorted by their primary / foreign key, to allow import based on table relationship rules.

So I'm trying to do something similar to the following: http://education.sqlfarms.com/education/ShowPost.aspx?PostID=50 but in VBA access.

So I need help getting a list of local tables ordered in such a way as to allow insertions (tables with primary keys must be listed before those with matching foreign keys in a relationship)

Please help

0


a source to share


1 answer


Here's a rough diagram that might help.



Option Explicit

Public i

Sub GetTableOrder()
Dim tdf As TableDef
Dim db As Database
Dim rs As New ADODB.Recordset

Set db = CurrentDb

''Create a disconnected recordset
rs.Fields.Append "TableName", adVarChar, 50
rs.Fields.Append "Level", adInteger

rs.CursorType = adOpenStatic
rs.Open

For Each tdf In db.TableDefs
    ''Skip system tables
    If Left(tdf.Name, 4) <> "Msys" Then
        rs.AddNew "TableName", tdf.Name
        rs.Update

        i = 0
        RelRun tdf.Name, i

        rs!Level = i
        rs.Update
    End If
Next

rs.MoveFirst

''Delete order
''ASC is the default sort order, so it is not
''necessary, and only included for illustration.

rs.Sort = "Level ASC"

''Not a good place for this line
''It is only here for convenience (mine :) )
DelRecs rs

End Sub

Function RelRun(TableName, i)
Dim rel As Relation
Dim db As Database
Dim blnFound As Boolean
Dim TableForeign As String

Set db = CurrentDb

    For Each rel In db.Relations

        If rel.Table = TableName Then
            i = i + 1
            TableForeign = rel.ForeignTable
            blnFound = True
        End If

    Next

    If blnFound Then
        ''Round and round to the end of the line
        RelRun TableForeign, i
    End If

End Function

Sub DelRecs(rs As ADODB.Recordset)
Dim strSQL As String
Dim db As Database

Set db = CurrentDb

    Do While Not rs.EOF
        strSQL = "DELETE FROM [" & rs!TableName & "]"
        db.Execute strSQL
        Debug.Print rs!TableName & " : " & db.RecordsAffected
        rs.MoveNext
    Loop

End Sub

      

0


a source







All Articles