Linking SQL tables to Access - How do I do it with VBA?

[ChasBoots]

Greetings all...

I have an Access XP database that I initially created by linking tables from a SQL Server database with a system DSN. I am now in the process of trying to find out how I can apply code to relink the tables with a DSN-less connection string AND with SQL Server authentication. Windows authentication will not work here. I spent the entire day trying a variety of methods the became dead-ends for me.

My preference at this point would be to set the code to run when the database opens. Currently, I have a form that is launched via an Autoexec macro and would not be opposed to including the code with the form. Your assistance is greatly appreciated. Thanks.

Chas...

 

[Trevil]

Let me see if I understand: Your database has x number of linked tables, and you want to relink those tables 'on demand'? If so, the following code can be adapted to relink ALL tables.

Function Refresh_Table_Link(strTableName As String, strLinkPath As String)
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim iLen As Integer
Dim iStart As Integer
Dim iEnd As Integer
Dim strStart As String
Dim strEnd As String
Dim strNewConnect As String


10 On Error GoTo Error_Trap

' This code uses the RefreshLink method to refresh the data in all linked
' tables after its connection has been changed from one data source to another.

20 Set dbs = CurrentDb
30 Set tdf = dbs.TableDefs(strTableName)
40 If tdf.Connect <> "" Then ' If not empty, it's linked
50 iLen = Len(tdf.Connect)
60 iStart = InStr(1, tdf.Connect, "Database=")
70 If iStart = 0 Then
80 MsgBox "Internal Error - did not find 'DATABASE=' in Connect string '" & tdf.Connect & "'"
90 Else
100 strStart = Left(tdf.Connect, iStart + 8)
110 iEnd = InStr(iStart, tdf.Connect, ".mdb")
120 If iEnd = 0 Then
130 MsgBox "Internal Error - did not find '.mdb' in Connect string '" & tdf.Connect & "'"
140 Else
150 If iEnd + 3 = iLen Then ' Good, path is at end of line.
160 strStart = Left(tdf.Connect, iStart + 8)
170 strNewConnect = strStart & strLinkPath
180 Else
190 strStart = Left(tdf.Connect, iStart + 8)
200 strEnd = Mid(tdf.Connect, iEnd + 4)
210 strNewConnect = strStart & strLinkPath & strEnd
220 End If
230 End If
240 End If
250 tdf.Connect = strNewConnect
260 tdf.RefreshLink
270 Else
280 End If
290 CurrentDb.TableDefs.Refresh
300 Set tdf = Nothing

310 Early_Exit:
320 Exit Function
330 Error_Trap:
340 Err.Source = "Module xxx: Refresh_Table_Link at Line: " & Erl
350 DocAndShowError
360 Resume Early_Exit
370 Resume Next
End Function


Code: Where the vision is often rudely introduced to reality!

 

[cmmrfrds]

You can also do it this way. This is linking 1 table, you would need to setup a loop to do all your tables.

Public Function SQLServerLinkedTable()
Dim oCat As ADOX.Catalog
Dim oTable As ADOX.Table
Dim sConnString As String

' Set SQL Server connection string used in linked table.
sConnString = "ODBC;" & _
"Driver={SQL Server};" & _
"Server={bigtuna};" & _
"Database=pubs;" & _
"Uid=sa;" & _
"Pwd=;"

' Create and open an ADOX connection to Access database
Set oCat = New ADOX.Catalog
oCat.ActiveConnection = CurrentProject.Connection

' Create a new Table object
Set oTable = New ADOX.Table

With oTable
.Name = "authors"
Set .ParentCatalog = oCat
.Properties("Jet OLEDB:Create Link") = True
.Properties("Jet OLEDB:Remote Table Name") = "authors"
.Properties("Jet OLEDB:Link Provider String") = sConnString
End With

' Add Table object to database
oCat.Tables.Append oTable
oCat.Tables.Refresh
Set oCat = Nothing

End Function

To refresh the link tables.

Public Function SQLServerLinkedTableRefresh()
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table

Set cat = New ADOX.Catalog
Set tbl = New ADOX.Table

Dim sConnString As String

' Set SQL Server connection string used in linked table.
sConnString = "ODBC;" & _
"Driver={SQL Server};" & _
"Server={local};" & _
"Database=pubs;" & _
"Uid=sa;" & _
"Pwd=;"

' Open the catalog.
cat.ActiveConnection = CurrentProject.Connection
For Each tbl In cat.Tables
If tbl.type = "LINK" And tbl.Name = "authors" Then
tbl.Properties("Jet OLEDB:Link Datasource") = sConnString
End If
Next
End Function

 

[ChasBoots]

Thanks for the code guys. I want to use the code from cmmrfrds but I am uncertain as to how to include the loop in order for the links to be refreshed. The SQL database has roughly 20 tables and at least 40 views. My primary interest is for the tables to be linked from SQL into Access with the same names. I am looking for the easiest way to execute the loop, whether that includes the views or not. Obviously, I would prefer not write code to link each individual table by name, if that can be done. Thanks again...

Chas

 

[cmmrfrds]

On the relink, the name already exists. To create the initial links you would need to include names.

For Each tbl In cat.Tables
If tbl.type = "LINK" Then
tbl.Properties("Jet OLEDB:Link Datasource") = sConnString
End If
Next

 

[ChasBoots]

Ok, I think I am on the right track but still having a problem. The code you gave me has morphed into the following (all variables are publically declared):

Public Function SQLServerLinkedTableRefresh()
 
On Error GoTo OpenConnectionError

Set cnn = New ADODB.Connection
With cnn
    .Provider = "SQLOLEDB"
    .Properties("Data Source").Value = "servername"
    .Properties("Initial Catalog").Value = "catalog"
    .Properties("Prompt") = adPromptComplete
    .Properties("Persist Security Info") = True
    .Properties("User ID").Value = "userid"
    .Properties("Password").Value = "password"
    .Open
End With
Debug.Print cnn
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = cnn
Set tbl = New ADOX.Table

   For Each tbl In cat.Tables
        If tbl.Type = "TABLE" Then
            tbl.Properties("Jet OLEDB:Link Provider String") = cnn.ConnectionString
        End If
   Next
Exit Function

OpenConnectionError:
    
    Set cat = Nothing

    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then cnn.Close
    End If
    Set cnn = Nothing

    If Err <> 0 Then
        MsgBox Err.Source & "-->" & Err.Description, , "Error: " & Err.Number
        
    End If
   
End Function

When the code hits the following line --

            tbl.Properties("Jet OLEDB:Link Provider String") = cnn.ConnectionString

I get an error that reads as follows:

"Item cannot be found in the collection corresponding to the requested name or ordinal."

This equates to Run-time error 3265.

Some additional information I have encountered as a result of working on this....

When I first started using the code the previous posts, tbl.Type was "Pass-Through". Now it is "Table" (hence the change in the conditional statement).

Second, and probably most importantly, I had forgotten that, after I initially linked the tables from SQL Server to Access via a system ODBC connection, I renamed them all to remove a common "prefix". For example, on the SQL Server, the tables were all named "prefix.tablename" and, after they were linked, the table names in Access were shortened to just "tablename". I did this in part for consistency since one database model will copied for other similar databases that have different connection strings and different prefixes.

I hope that this makes sense and that someone can offer a suggestion on what I am missing. Thanks.

Chas

 

[cmmrfrds]

On a refresh as opposed to a create try
tbl.Properties("Jet OLEDB:Link Datasource") = cnn.ConnectionString

 

[ChasBoots]

Well, I am still going crazy here. I've tried using

tbl.Properties("Jet OLEDB:Link Datasource") = cnn.ConnectionString
AND
tbl.Properties("Jet OLEDB:Link Provider String") = cnn.ConnectionString
but still have problems. My inexperience with ADO really became obvious to me when I realized I spent way too much time trying to refresh the links in the wrong direction (from SQL to Access instead of the other way).

My code currently appears as follows:

Public Function SQLServerLinkedTableRefresh()
    
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim cnn As New ADODB.Connection
Dim sConnString As String
Dim prp As ADOX.Property
Dim ADOerr As ADODB.Error
Dim i As Integer
Dim strerror As String

On Error GoTo OpenConnectionError

sConnString = "Driver={SQL Server};" & _
           "Server=servername;" & _
           "Database=mydatabase;" & _
           "Uid=uname;" & _
           "Pwd=password;"
           
cnn.Open sConnString
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection

Set tbl = New ADOX.Table

   For Each tbl In cat.Tables
   Debug.Print tbl.Name & " " & tbl.Type
        If tbl.Type = "PASS-THROUGH" Then
            tbl.Properties("Jet OLEDB:Link Datasource") = sConnString
        End If
   Next
cat.Tables.Refresh

Exit Function

OpenConnectionError:
    
    Set cat = Nothing

    If Not cnn Is Nothing Then
        If cnn.State = adStateOpen Then cnn.Close
    End If

    'Error trapping Code
    For Each ADOerr In cnn.Errors
        strerror = "Error #" & ADOerr.Number & vbCr & _
                " " & ADOerr.Description & vbCr & _
                " (Source: " & ADOerr.Source & ")" & vbCr & _
                " (SQL State: " & ADOerr.SQLState & ")" & vbCr & _
                " (NativeError: " & ADOerr.NativeError & ")" & vbCr

        Debug.Print strerror
    Next

    Set cnn = Nothing

    If Err <> 0 Then
    Debug.Print Err.Description
    Debug.Print Err.Number
        MsgBox Err.Source & "-->" & Err.Description, , "Error: " & Err.Number
        
    End If
End Function

If I use "Jet OLEDB:Link Datasource" I get the following errors from ADO:

Error #0
[Microsoft][ODBC SQL Server Driver][SQL Server]Changed database context to 'mydatabase'.
(Source: Microsoft OLE DB Provider for ODBC Drivers)
(SQL State: 01000)
(NativeError: 5701)

Error #0
[Microsoft][ODBC SQL Server Driver][SQL Server]Changed language setting to us_english.
(Source: Microsoft OLE DB Provider for ODBC Drivers)
(SQL State: 01000)
(NativeError: 5703)

ODBC--connection to '{SQL Server}servername' failed.
-2147467259


If I use "Jet OLEDB:Link Provider String", the code works without stopping but if I try to open a table, query or form that connects to the SQL database, I get a "SQL Server Login" error which indicates failed authentication for a secure connection. The properties that follow here refer to one of the tables that are being re-linked.

LU_APPNAME
Temporary Table False
Jet OLEDB:Table Validation Text
Jet OLEDB:Table Validation Rule
Jet OLEDB:Cache Link Name/Password False
Jet OLEDB:Remote Table Name dbo.LU_APPNAME
Jet OLEDB:Link Provider String DRIVER=SQL Server;SERVER=servername;APP=Microsoft Open Database Connectivity;WSID=A124875;DATABASE=mydatabase
Jet OLEDB:Link Datasource
Jet OLEDB:Exclusive Link False
Jet OLEDB:Create Link True
Jet OLEDB:Table Hidden In Access False

I tried setting tbl.properties("Jet OLEDB:Cache Link Name/Password") = True in the loop that sets the connection for each table thinking that's what would allow the SQL tables to be accessible through the Access database. That generates run time error -2147217887:
"Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was done."


Suffice it to say I appreciate any input. One of these days. Thanks...

Chas

 

[cmmrfrds]

The only suggestion I have at this point is to try and make the original connection code work first without any modifications. Notice the original code I showed uses ODBC keyword in the connection, try that once.