How to get unique Record Identifiers working OK when linking Access to SQL Server



I wish to link an Access application to a SQLServer Database by VBA and have
managed to do this. The problem I have is that the linked tables are not
updateable. If I link to the same tables via the user interface (Tools>Link
Tables etc) they are.

I think the issue is that my code does not select a unique record identifier
for the table (which you are prompted to do in the user interface). Can I
do that in VBA.

Here is my code

Private Sub PopSqlServerTbls(strAccessTbl, strDBName, strTblName,
strDataSourceName, strUserID, strPword)

Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table

Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection

Set tbl = New ADOX.Table
tbl.Name = strAccessTbl
Set tbl.ParentCatalog = cat

tbl.Properties("Jet OLEDB:Create Link") = True
tbl.Properties("Jet OLEDB:Link Provider String") = "ODBC" & ";DATABASE=" &
strDBName & ";UID=" & strUserID & ";PWD=" & strPword & ";DSN=" &
tbl.Properties("Jet OLEDB:Remote Table Name") = strTblName

cat.Tables.Append tbl
End Sub

Joe Fallon

I did something like that in DAO code.
Look for "pseudo index" below:

I use this procedure to re-create links to Oracle.
There is a local Access table (tblODBCTables) that contains the table names
and primary key fields I want to link to on the Server.
Note: the source table name needs the Schema User prefix which is in the
code. The linked table name usually omits this.

Public Function LinkOracleTables(strDSN As String, strSchema As Variant,
strSchemaPwd As Variant) As Boolean
On Error GoTo Err_LinkOracleTables

Dim db As Database, rs As Recordset, tdfAccess As TableDef, qdf As
Dim dbODBC As Database, strConnect As String, strSQL As String

If strDSN = "" Then
MsgBox "You must supply a DSN in order to link tables."
Exit Sub
strConnect = "ODBC;DSN=" & strDSN & ";UID=xyz" & ";PWD=abc;"
End If

SysCmd acSysCmdSetStatus, "Connecting to Oracle..."

Call DeleteODBCTableNames

Set db = CurrentDb
Set rs = db.OpenRecordset("tblODBCTables")
Set dbODBC = OpenDatabase("", False, False, strConnect)
DoCmd.SetWarnings False

Do While Not rs.EOF
Set tdfAccess = db.CreateTableDef(rs![LinkTablename], dbAttachSavePWD)
tdfAccess.Connect = dbODBC.Connect
tdfAccess.SourceTableName = strSchema & "." & rs![LinkTablename]
db.TableDefs.Append tdfAccess
'run pseudo index queries here. If the table does not exist then this
gets skipped.
strSQL = "CREATE INDEX " & rs![LinkTablename] & "Idx ON " &
rs![LinkTablename] & " (" & rs![IndexFields] & ");"
DoCmd.RunSQL strSQL

LinkOracleTables = True

On Error Resume Next
DoCmd.SetWarnings True
Set rs = Nothing
Set dbODBC = Nothing
Set db = Nothing
SysCmd acSysCmdClearStatus
Exit Function

Select Case Err.Number
Case 3151
MsgBox ("There is an ODBC datasource problem." & vbCrLf & "Please
verify the DSN and database are spelled correctly." & vbCrLf & "Note: They
can be case sensitive.")
Case 3265, 3011, 7874 'item not in collection - table does not exist, or
can't find object
Resume TableNotInCollection
Case Else
MsgBox "Error # " & Err.Number & " was generated by " & Err.Source &
vbCrLf & Err.Description, , "LogOnCode - LinkOracleTables"
End Select
LinkOracleTables = False
Resume Exit_LinkOracleTables

End Function

'This procedure deletes all linked ODBC table names in an mdb.
Public Sub DeleteODBCTableNames()
On Error GoTo Err_DeleteODBCTableNames

Dim dbs As Database, tdf As TableDef, I As Integer
Set dbs = CurrentDb
For I = dbs.TableDefs.Count - 1 To 0 Step -1
Set tdf = dbs.TableDefs(I)
If (tdf.Attributes And dbAttachedODBC) Then
dbs.TableDefs.Delete (tdf.Name)
End If
Next I

Set dbs = Nothing

Exit Sub

MsgBox ("Error # " & Str(Err.Number) & " was generated by " & Err.Source
& Chr(13) & Err.Description)
Resume Exit_DeleteODBCTableNames

End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question