I am in the process of converting DAO code to ADO. I have written the procedure listed below which doesn't work. It links the 1st table of the Back End database and fails when linking the 2nd table in the list.

I would greatly appreciate if anyone with knowledge of ADOX could help me and show where I went astray.

Many thanks in advance. . . .

and here is the procedure!

Private Function fnCreateNewLinks(ByVal strLBackEndDB As String)
On Error GoTo ErrorHandler
bytCancel = 0

Dim adoBackEndConn As New ADODB.Connection
Dim adoBackEndCat As New ADOX.Catalog
Dim adoBackEndTable As New ADOX.Table

Dim adoFrontEndConn As New ADODB.Connection
Dim adoFrontEndCat As New ADOX.Catalog
Dim adoFrontEndTable As New ADOX.Table

adoBackEndConn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data BackEnd=" & strLBackEndDB & ";"
adoFrontEndConn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data BackEnd=" & Application.CurrentDb.Name & ";"

adoBackEndCat.ActiveConnection = adoBackEndConn
adoFrontEndCat.ActiveConnection = adoFrontEndConn

Set adoBackEndTable.ParentCatalog = adoBackEndCat
Set adoFrontEndTable.ParentCatalog = adoFrontEndCat

For Each adoBackEndTable In adoBackEndCat.Tables

With adoBackEndTable

If Left$(adoBackEndTable.Name, 4) = "MSys" Then GoTo NextTable

With adoFrontEndTable
adoFrontEndTable.Name = adoBackEndTable.Name
adoFrontEndTable.Properties("Jet OLEDB:Link DataBackEnd") = strLBackEndDB
adoFrontEndTable.Properties("Jet OLEDB:Remote Table Name") = adoBackEndTable.Name
adoFrontEndTable.Properties("Jet OLEDB:Create Link") = True
End With

End With

adoFrontEndCat.Tables.Append adoFrontEndTable


Next adoBackEndTable


Set adoBackEndConn = Nothing: Set adoBackEndCat = Nothing: Set adoBackEndTable = Nothing
Set adoFrontEndConn = Nothing: Set adoFrontEndCat = Nothing: Set adoFrontEndTable = Nothing

Exit Function


MsgBox Err.Number & vbCrLf & Err.Description, Application.CurrentObjectName
Err.Clear: Resume ResumeErr

End Function