Creating Relationships dynamically

[GSUser]

I have a table that has the names of tables I want to create, I can get the tables made but when I try to create a relationship from that table to another I am having a problem. I'm sure it's just that I don't understand how the create relationship part of the code works.
Can someone please check my code and assist. Thanks in advance.

Private Sub CreateTable_Click()

Dim dbs As Database, tdf As TableDef, fld As Field, fld1 As Field, fld2 As Field, fld3 As Field, fld4 As Field, rel As Relation
Dim rst As Recordset, TblCnt As Integer, idx As Index, fldIndex As Field, frm As Form, ctl As Control
Dim tblName As String
Dim CU
CU = fOSUserName()

Set frm = Forms!CreateTables
Set ctl = frm!ProgressBar
ctl = 0
    ' Return reference to current database.
    Set dbs = CurrentDb
    ' Return the number of records
    Set rst = dbs.OpenRecordset("rProcesses")
    TblCnt = rst.RecordCount
    ' Open the table and Go to the first record
    DoCmd.OpenForm "Processes", acNormal, acReadOnly, , , acHidden
        DoCmd.GoToRecord acDataForm, "Processes", acFirst
    If IsNull(Forms!Processes.ProcessName) Then
    MsgBox "You must enter the processes first!", vbOKOnly, "Processes required"
    Exit Sub
    End If
    ' Begin a loop to check if the table already exists
    Do Until rst.EOF
    tblName = Forms!Processes.ProcessName
    frm.Caption = "Creating " & tblName
    ctl.Max = rst.RecordCount
    If fnObjExists("Table", tblName) Then
    DoCmd.GoToRecord acDataForm, "Processes", acNext
    Else
    ' Return TableDef object variable that points to new table.
    Set tdf = dbs.CreateTableDef(tblName)
    ' Define new field in table.
    Set fld1 = tdf.CreateField("Stand", dbText, 10)
    Set fld2 = tdf.CreateField("TeamID", dbInteger)
    Set fld3 = tdf.CreateField("WageAmount", dbCurrency)
    Set fld4 = tdf.CreateField("WageDate", dbDate)
    ' Append Field objects to Fields collection of TableDef object.
    tdf.Fields.Append fld1
    tdf.Fields.Append fld2
    tdf.Fields.Append fld3
    tdf.Fields.Append fld4
    tdf.Fields.Refresh
    ' Create the index
    Set idx = tdf.CreateIndex(tblName)
    Set fldIndex = idx.CreateField("Stand", dbText, 10)
    ' Append index fields.
    idx.Fields.Append fldIndex
    ' Set Primary property.
    idx.Primary = True
    ' Append index.
    tdf.Indexes.Append idx
    ' Append TableDef object to TableDefs collection of database.
    dbs.TableDefs.Append tdf
    dbs.TableDefs.Refresh
    Set rel = dbs.CreateRelation(, "Stands", tblName)
    rel.Fields.Append rel.CreateField("Stand")
    rel.Fields(tblName).ForeignName = "Stand"
    dbs.Relations.Append rel

    DoCmd.GoToRecord acDataForm, "Processes", acNext
    End If
    rst.MoveNext
    ctl = ctl + 1
    Loop
    Set dbs = Nothing
    DoCmd.Close acForm, "Processes"
    ctl = 0
    frm.Caption = "Table Creation Complete!"
    MsgBox "All Tables successfully created!", vbOKOnly, "Table Creation Successful"
End Sub

And this is where I get an error:

rel.Fields(tblName).ForeignName = "Stand"

error 3265, item not found in this collection.

 

[Remou]

There should be no need to create tables in a live system, the structure of your table should be:

[tt]Process
Stand
TeamID
WageAmount
WageDate[/tt]

That way there is no need to create tables, just filter a single table for the required process.

That being said, there are a number of problems with this code.

* You have no error handling, you must have error handling.

* You have not explicitly declared fields and indexes as DAO:
[tt]Dim fld as DAO.Field[/tt]
This often leads to problems if new libraries are added or the library order is changed.

* You have not indented, proper indentation will often show problems that would otherwise be difficult to see. Always indent, you will thank yourself later.

* Finally ...

'There is no point in all of this
'as the form is opened hidden.
[s]Set frm = Forms!CreateTables
Set ctl = frm!ProgressBar
ctl = 0[/s]
    ' Return reference to current database.
    Set dbs = CurrentDb
    ' Return the number of records
'Only return records that have Process names
'It would be best to list the relevant fields rather
'than use *
    Set rst = dbs.OpenRecordset _
      ("SELECT * FROM rProcesses WHERE ProcessName Is Not Null")

'No need for this
[s]    TblCnt = rst.RecordCount
    ' Open the table and Go to the first record
    DoCmd.OpenForm "Processes", acNormal, acReadOnly, , , acHidden
        DoCmd.GoToRecord acDataForm, "Processes", acFirst
    If IsNull(rst!ProcessName) Then[/s]

    If rs.EOF Then
        MsgBox "You must enter the processes first!", vbOKOnly, "Processes required"
        Exit Sub
    End If

    ' Begin a loop to check if the table already exists
    Do Until rst.EOF
        'Not here, keep reading
        [s]tblName = rst!ProcessName[/s]
       
        'No point in doing this, the form is hidden
        [s]    frm.Caption = "Creating " & tblName[/s]
        'Not sure why you would do this
        'ctl.Max = rst.RecordCount
    
        If fnObjExists("Table", rst!ProcessName) Then
            [s]DoCmd.GoToRecord acDataForm, "Processes", acNext[/s]
            rst>MoveNext
            'Or GoTo the normal exit
            If rst.EOF Then Exit Sub
         Else
             'Very important - you have moved,  
             'so you need a new table name, 
             'so here is a good place:
             tblName = rst!ProcessName

And so on.

What was wrong with this is that you appended the field and once appended, it is, as far as I recall, read only. Also, you must have a name for your Relationship.

    Set rel = dbs.CreateRelation("xyz", "Stands", tblName)
    Set fldX = rel.CreateField("Stand")
    fldX.ForeignName = "Stand"
    rel.Fields.Append fldX
    dbs.Relations.Append rel