Create Relation between Linked Tables [VBA]

Jhaqen

New member
Local time
Today, 04:28
Joined
Sep 20, 2008
Messages
3
Hello,

How do I append a relation between, two linked tables, to a database in VBA?
I can do this fine manually (using the relations table) but I get the following error at the line

"CurrentDB.Relations.Append rel"

"Run-time error 3057: Operation not supported on linked tables"

I have two tables that are linked to excel spreadsheets. The location of these spreadsheets may change and rather that have the user go in and manually change the connection, I would rather have them change it using a form.

In the code below I get the spreadsheet location from a textbox, create a new table (as the connect property of the original is read only), delete the original relation and table and append the new table. The relation append will not work though. I'm using Access '07.

Code:

Code:
Private Sub btnLinkXls1_Click()
    Dim tblSpreadsheet1 As Object
    Dim connectString As String
    Dim sourceTblName As String
    Dim tdfNew As TableDef
    Dim rel As relation
    Dim fld As Field
      
    'Note - The connection string is in the following format:
    '"Excel 8.0;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=connectString;TABLE=Sheet1$"
    
    'Get the value entered into the text box
    txtXls1Location.SetFocus
    connectString = txtXls1Location.Text
    
    'Build the connection string
    connectString = "Excel 8.0;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=" + connectString + ";TABLE=Sheet1$"
    
    'Create new table as property is read-only and cannot be modified
    
    'Get original SourceTableName
    sourceTblName = CurrentDb.TableDefs("Spreadsheet1").SourceTableName
    
    'Copy existing table and relation
    Set tdfNew = CurrentDb.CreateTableDef("Spreadsheet1")
    Set rel = CurrentDb.CreateRelation("Spreadsheet1Spreadsheet2", "Spreadsheet1", "Spreadsheet2")
    Set fld = rel.CreateField("orderID")
    fld.ForeignName = "order number"
    rel.Fields.Append fld
    
    'Change the connect property and source worksheet in the copy
    tdfNew.Connect = connectString
    tdfNew.SourceTableName = sourceTblName

    'Delete original table and relation, relation first
    CurrentDb.Relations.Delete "Spreadsheet1Spreadsheet2"
    DoCmd.DeleteObject acTable, "Spreadsheet1"

    'Create the new table
    CurrentDb.TableDefs.Append tdfNew
    
    'Add table relations
    CurrentDb.Relations.Append rel '******ERROR OCCURS HERE*****
    
    'Refresh!
    CurrentDb.TableDefs.Refresh
    
End Sub

Thanks for any help.
 
Set fld = rel.CreateField("orderID")
fld.ForeignName = "order number"
rel.Fields.Append fld

first of all please elaborate on what you are trying to do in this section . For i believe you are being off syntax in here :(

Now do note this section from microsoft msdn :
If the object you're appending isn’t complete (such as when you haven’t appended any Field objects to a Fields collection of an Index object before it’s appended to an Indexes collection) or if the properties set in one or more subordinate objects are incorrect, using the Append method causes an error. For example, if you haven’t specified a field type and then try to append the Field object to the Fields collection in a TableDef object, using the Append method triggers a run-time error.
 
Thanks for the reply. :)

Before I added that section I was getting an error 3366: "Cannot append a relation with no fields defined" when trying to append the relation. So I checked the fields contained in the relation when created manually and I've tried to add them (just the one) to the new relation I've created in code.

Can you see anything I may be missing? :confused:
 
Note: I get the following when I click on "Help" with the message:

"Import data from the table, and then try the operation again."
 
Hey, I am having the same kind of issue. I have it being appended to an index fields and then my error is when I am trying to append it to the tabledef. Any direction into what i am not seeing would be helpful

Function UpdateData()
On Error GoTo Err_UpdateData

Begin_UpdateData:
DoCmd.TransferSpreadsheet acImport, , "UpdateData", "..\..\UpdateData.xlsx", True

Dim dbs As DAO.Database, tdf As DAO.TableDef
Dim idx As DAO.Index
Dim fldWONUM As DAO.Field, fldWoLine As DAO.Field, fldOperation As DAO.Field

Set dbs = CurrentDb
Set tdf = dbs.TableDefs!UpdateData
Set idx = tdf.CreateIndex("UpdateData")
Set fldWONUM = idx.CreateField("WO NUM", dbText)
Set fldWoLine = idx.CreateField("Wo Line", dbText)
Set fldOperation = idx.CreateField("Operation", dbText)

idx.Fields.Append fldWONUM
idx.Fields.Append fldWoLine
idx.Fields.Append fldOperation

idx.Primary = True

tdf.Indexes.Append idx
tdf.Indexes.Refresh
Set dbs = Nothing

Exit_UpdateData:
Exit Function

Err_UpdateData:
Dim strSQL As String
strSQL = "DELETE FROM UpdateData"
DoCmd.RunSQL strSQL
Resume Begin_UpdateData

End Function
 

Users who are viewing this thread

Back
Top Bottom