Use macro's or VBA to write table relationships after import table

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi there

Is there a way to "automate" the writing of realtionships between imported
tables?

I have a situation where I need to re-import tables through an ODBC
connection into access a few times a day, and I need the relationships to be
maintained.

Currently, any macro wirtten to delete and then re-import the tables,
requires all relationships to be deleted first.

Is there a way to 1) delete the existing relatiohsips 2) delete the exiting
tables 3) re-import the updated tables 4) re-create the relationships ??

Thanks in advance for any advice you may be able to offer.

MTN
 
Instead of deleting and re-importing the tables, use delete queries to
delete the *records* they contain. Then import the updated data into the
existing tables. Assuming that the relationships enforce relational
integrity, you'll need to be careful about the order in which you run
the queries and import the data.

But would it not be simpler to use linked tables to access the ODBC
datasource? That way, you'd always have the latest data and there'd be
no need to delete and re-import stuff.
 
Here's a snippet of code I just wrote that will go to another identical access mdb and pull in the data to replace the current mdb's data. It also will drop and rewrite the table relations. Thought it might be useful to those who had as many problems finding help no this as I did.

Code: 
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim fieldName As Variant
    
    DoCmd.RunSQL "CREATE TABLE MyTables([TableName] VARCHAR(50))"
    DoCmd.RunSQL "CREATE TABLE MyRelations([RelationName] VARCHAR(50), [Attributes] VARCHAR(50), [TableName] VARCHAR(50), [ForeignName] VARCHAR(50))"
    DoCmd.RunSQL "CREATE TABLE MyRelationFields([RelationName] VARCHAR(50), [Field] VARCHAR(50), [Foreign] VARCHAR(50))"
    DoCmd.RunSQL "INSERT INTO MyTables(TableName) SELECT name from MSysObjects where type = 1 and flags = 0 and name not in('MyTables','MyRelations','MyRelationFields')"
    
    
    For Each rel In CurrentDb.Relations
      DoCmd.RunSQL "INSERT INTO MyRelations(RelationName, Attributes, TableName, ForeignName) VALUES('" & rel.Name & "','" & rel.Attributes & "','" & rel.Table & "','" & rel.ForeignTable & "')"
        For Each fld In rel.Fields
            DoCmd.RunSQL "INSERT INTO MyRelationFields(RelationName, Field, Foreign) VALUES('" & rel.Name & "','" & fld.Name & "','" & fld.ForeignName & "')"
        Next
    Next
    
    While CurrentDb.Relations.Count > 0
        With CurrentDb
            For Each rel In .Relations
                .Relations.Delete rel.Name
            Next
        End With
    Wend

    Set db = CurrentDb()
    Set rs = db.OpenRecordset("select TableName from MyTables")

    While Not rs.EOF
        DoCmd.RunSQL "Delete * from [" & rs.Fields("TableName") & "]"
        DoCmd.TransferDatabase acImport, "Microsoft Access", Me.ImportPath, acTable, rs.Fields("TableName"), "TempTable"
        DoCmd.RunSQL "INSERT INTO [" & rs.Fields("TableName") & "] SELECT * from TempTable"
        DoCmd.RunSQL "DROP TABLE TempTable"
        rs.MoveNext
    Wend

    rs.Close

    Set rs = db.OpenRecordset("select * from MyRelations")


    With CurrentDb
        While Not rs.EOF
            Set rel = .CreateRelation(rs.Fields("RelationName"), rs.Fields("TableName"), rs.Fields("ForeignName"), rs.Fields("Attributes"))
                If DCount("Field", "MyRelationFields", "RelationName = '" & rs.Fields("RelationName") & "'") < 2 Then
                    fieldName = DLookup("Field", "MyRelationFields", "RelationName = '" & rs.Fields("RelationName") & "'")
                    rel.Fields.Append rel.CreateField(fieldName)
                    rel.Fields(fieldName).ForeignName = fieldName
                Else
                    Set rs2 = db.OpenRecordset("select Field from MyRelationFields where RelationName = '" & rs.Fields("RelationName") & "'")
                        While Not rs2.EOF
                            rel.Fields.Append rel.CreateField(rs2.Fields("Field"))
                            rel.Fields(rs2.Fields("Field")).ForeignName = rs2.Fields("Foreign")
                            rs2.MoveNext
                        Wend
                    rs2.Close
                End If
                .Relations.Append rel
        rs.MoveNext
        Wend
    End With
    rs.Close
    
    DoCmd.RunSQL "DROP TABLE MyRelationFields"
    DoCmd.RunSQL "DROP TABLE MyRelations"
    DoCmd.RunSQL "DROP TABLE MyTables"
 
Last edited:
Back
Top