Link ODBC programatically?

  • Thread starter Thread starter Todd E.
  • Start date Start date
T

Todd E.

Can someone offer some reference or instruction on how to
link a ODBC table programmatically within access.

Also can a ODBC datasource also be added via code from
within access?? (for example a foxpro driver)

Any help is welcome, thanks in advance!

Todd
 
Here are 3 procedures that may help with ODBC linking:


Public Sub LinkAllODBCTables(strDSN As String)
Dim dbs As Database
Dim dbsODBC As Database
Dim tdfODBC As TableDef, tdfAccess As TableDef
Dim connectStr As String, linkname As String

If IsNull(strDSN) Then
connectStr = "OBDC;"
linkname = ""
Else
connectStr = "ODBC;DSN=" & strDSN
linkname = strDSN
End If

Set dbs = CurrentDb
Set dbsODBC = OpenDatabase(linkname, dbDriverCompleteRequired, False,
connectStr)

For Each tdfODBC In dbsODBC.TableDefs
If Left(tdfODBC.Name, 4) = "dbo." Then
'It is a SQL Server Table
'If Left(tdfODBC.Name, 7) <> "dbo.sys" Then
'it is not a SQL Server system table so link to it.
Set tdfAccess = dbs.CreateTableDef(Mid(tdfODBC.Name, 5))
'End If
Else
Set tdfAccess = dbs.CreateTableDef(tdfODBC.Name)
End If

tdfAccess.Connect = dbsODBC.Connect

tdfAccess.SourceTableName = tdfODBC.Name
dbs.TableDefs.Append tdfAccess
Next

Set dbsODBC = Nothing
Set dbs = Nothing

End Sub

This code deletes all linked ODBC tables.
Try swapping dbAttachedODBC with dbAttachedTable for removing linked Access
tables.

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

dbs.Close
Set dbs = Nothing

Exit_DeleteODBCTableNames:
Exit Sub

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

End Sub



Sub ChangeODBC(mDSN As String, mDATABASE As String)
On Error Resume Next
Dim dbs As Database, tdf As TableDef, prpLoop As Property
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
If (tdf.Attributes And dbAttachedODBC) Then
For Each prpLoop In tdf.Properties
If prpLoop.Name = "Connect" Then
prpLoop.Value = "ODBC;DSN=" & mDSN & ";UID=id;PWD=pwd;DATABASE="
& mDATABASE & ";"
End If
Next prpLoop
tdf.RefreshLink
End If
Next tdf
dbs.Close
Set dbs = Nothing
End Sub
 
I use this procedure to re-create links to SQL Server.
(This eliminates the need to re-name all the tables to strip out dbo_ and it
allows you to point to different versions of the same database easily.)
There is a local Access table (tblODBCTables) that contains the table names
I want to link to on the Server.
Note: the source table name needs the dbo. prefix which is in the code. The
linked table name usualy omits this. .

Public Sub LinkSQLServerTables(strDSN As String, strDatabase)
On Error GoTo Err_LinkSQLServerTables

Dim dbs As Database, rs As Recordset, tdfAccess As TableDef
Dim dbsODBC As Database, strConnect As String

If strDSN = "" Then
MsgBox "You must supply a DSN in order to link tables."
Exit Sub
Else
strConnect = "ODBC;DSN=" & strDSN & ";UID=User;PWD=password;DATABASE=" &
strDatabase & ";"
End If

SysCmd acSysCmdSetStatus, "Connecting to SQL Server..."

Call DeleteODBCTableNames

Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("tblODBCTables")
Set dbsODBC = OpenDatabase("", False, False, strConnect)

Do While Not rs.EOF
Set tdfAccess = dbs.CreateTableDef(rs![LinkTablename], dbAttachSavePWD)
tdfAccess.Connect = dbsODBC.Connect
tdfAccess.SourceTableName = dbsODBC.TableDefs("dbo." &
rs![LinkTablename]).Name
dbs.TableDefs.Append tdfAccess
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set dbsODBC = Nothing
Set dbs = Nothing

Exit_LinkSQLServerTables:
SysCmd acSysCmdClearStatus
Exit Sub

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

End Sub


'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

dbs.Close
Set dbs = Nothing

Exit_DeleteODBCTableNames:
Exit Sub

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

End Sub
 
Back
Top