Automating the creation of table relations in Access using VBA

I am trying to automate the creation of all relationships in a database using VBA.

I have successfully found the code that can create individual relations and loop through a CSV to connect all single relations. The issue I'm encountering is when one field in the table needs to be linked to two foreign fields. I see I can do this manually but am having trouble locating where in the object the second relation is linked.

Public Function AddRelationship(strTable As String, strFTable As String, _ 
    strField As String, strFField As String, Optional intAttribute As DAO.RelationAttributeEnum = 2)

    On Error GoTo ErrHandler

    Dim db As Database
    Dim rel As DAO.Relation
    Dim errorCount

    Set db = CurrentDb
    Set rel = db.CreateRelation(strField, strTable, strFTable,_ dbRelationDontEnforce)

    With rel
        .Fields.Append .CreateField(strField)
        .Fields(strField).ForeignName = strFField
        .Attributes = intAttribute

    End With

    db.Relations.Append rel

    Exit Function

ErrHandler:

    MsgBox Err.Description + " " + strTable + " " + strField + " " +_  strFTable + " " + strFField
End Function


Sub DeleteandAddAllRelationships()

    Dim db As Database
    Dim totalRelations As Integer
    Dim appExcel As Excel.Application
    Dim myWorkbook As Excel.Workbook
    Dim rows As Integer
    Dim columns As Integer
    Dim relationsToAdd() As String
    Dim i As Integer
    Dim j As Integer


    Set appExcel = CreateObject("Excel.Application")
    Set myWorkbook =_ appExcel.Workbooks.Open("C:\Users\ian.ebersole\Desktop\Relationships2.xlsx")
    Set db = CurrentDb()

    totalRelations = db.Relations.Count
    appExcel.Visible = False

    rows = 225
    columns = 7

    ReDim relationsToAdd(rows, columns)

    For i = 1 To 225
        For j = 1 To columns
            relationsToAdd(i, j) = myWorkbook.Sheets(1).Cells(i, j)
        Next j
    Next i

    myWorkbook.Close
    Set appExcel = Nothing
    Set myWorkbook = Nothing


    If totalRelations > 0 Then
        For i = totalRelations - 1 To 0 Step -1
            db.Relations.Delete (db.Relations(i).Name)
        Next i
    End If

    For i = 2 To 225
        Call AddRelationship(relationsToAdd(i, 1), relationsToAdd(i, 4),_ relationsToAdd(i, 2), relationsToAdd(i, 5))
    Next i

End Sub

It will successfully loop through any relations that are one field to one foreign field but will fail if the same field needs to be linked to a second field in the same table.

This is the function that ultimately worked for me. Probably not the best error handling but it did successfully create all the relationships I needed when using the sub in my original post.

Public Function AddRelationship(strRelCount As String, strTable As String, strFTable As String, strField As String, strFField As String, Optional intAttribute As DAO.RelationAttributeEnum = 2)

    On Error GoTo ErrHandler

    Dim db As Database
    Dim Rel As DAO.Relation
    Dim errorCount

    Set db = CurrentDb
    Set Rel = db.CreateRelation(strField, strTable, strFTable, dbRelationDontEnforce)

    With Rel
        .Fields.Append .CreateField(strField)
        .Fields(strField).ForeignName = strFField
        .Attributes = intAttribute
        .Name = Trim(strRelCount + Left(strTable + strField + strFTable + strFField, 43))


    End With

    db.Relations.Append Rel

    Exit Function

ErrHandler:

    On Error GoTo NextError
    errorCount = 1

    strTable = strTable + "_" + Str(errorCount)

    Set db = CurrentDb
    Set Rel = db.CreateRelation(strField, strTable, strFTable, dbRelationDontEnforce)

    With Rel
        .Fields.Append .CreateField(strField)
        .Fields(strField).ForeignName = strFField
        .Attributes = intAttribute
        .Name = Trim(strRelCount + Left(strTable + strField + strFTable + strFField, 43))

    End With

    db.Relations.Append Rel

    Exit Function

NextError:
    errorCount = 2

    On Error GoTo FinalError

    strTable = strTable + "_" + Str(errorCount)

    Set db = CurrentDb
    Set Rel = db.CreateRelation(strField, strTable, strFTable, dbRelationDontEnforce)

    With Rel
        .Fields.Append .CreateField(strField)
        .Fields(strField).ForeignName = strFField
        .Attributes = intAttribute
        .Name = Trim(strRelCount + Left(strTable + strField + strFTable + strFField, 43))

    End With

    db.Relations.Append Rel

    Exit Function

FinalError:

    MsgBox Err.Description + " " + strTable + " " + strField + " " + strFTable + " " + strFField


End Function