views:

142

answers:

1

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

For starters, the function should get a list of the tables in the local database, ordered by their primary/foreign key, so as to allow importation based on table relationship rules.

Therefore, i am trying to do something similar to the following: http://education.sqlfarms.com/education/ShowPost.aspx?PostID=50 , but in access VBA.

I therefore need help getting a list of the local tables, ordered in such a way as to allow inserts (the tables with the primary keys to be listed before those with corresponding foreign keys in relationships)

Kindly help

A: 

Here is a rough outline that may 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
Remou