Importer des données selon l'ordre des relations de table

Question

J'essaie de créer une fonction VBA d'importation générique dans la base de données d'accès. (Je lierai les tables externes d'une base de données similaire, puis importerai leurs données dans les tables locales.)

Pour commencer, la fonction doit obtenir une liste des tables de la base de données locale, triées par leur clé primaire/étrangère , afin de permettre l'importation sur la base des règles de relation de table.

Par conséquent, j'essaie de faire quelque chose de similaire à ce qui suit: http://education.sqlfarms.com/education/ShowPost.aspx?PostID=50, mais dans l'accès VBA.

Je dois donc aider à obtenir une liste des tables locales, commandés de telle manière à permettre des insertions (les tables avec les clés primaires à la liste avant ceux correspondant clés étrangères dans les relations)

Veuillez aider

Answer 1

Voici un aperçu qui peut aider.

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