Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations biv343 on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Linking tables to a new SQL server 1

Status
Not open for further replies.

AT76

Technical User
Apr 14, 2005
460
US
Hi,

I have an access app which gets data from a SQL server. The server will be changing and I need to relink all the linked tables to the new SQL server. I found code in the web to do this but I'm having some trouble applying it.

Here's what I have:

Private Sub cmdLink11_Click()

Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim rst As DAO.Recordset
Dim strServer As String
Dim strDB As String
Dim strTable As String
Dim strConnect As String
Dim strMsg As String

On Error GoTo HandleErr

' Build base authentication strings
strConnect = "ODBC;DRIVER={sql server};DATABASE=xxx" & _
";SERVER=xxx" & _
";Trusted_Connection=Yes;"

' Create recordset to obtain server, database and table names
Set db = CurrentDb
Set rst = db.OpenRecordset("tblSQLTables", dbOpenSnapshot)

If rst.EOF Then
strMsg = "There are no tables listed in tblSQLTables."
End If

' Walk through the recordset and create the links
Do Until rst.EOF
strServer = rst!SQLServer
strDB = rst!SQLDatabase
strTable = rst!SQLTable
' Create a new TableDef object
Set tdf = db.CreateTableDef(strTable)
' Set the Connect property to establish the link
tdf.Connect = strConnect & "Server=" & strServer & ";Database=" & strDB & ";"
tdf.SourceTableName = strTable
' Append to the database's TableDefs collection
db.TableDefs.Append tdf
tdf.RefreshLink
'tdf.close
rst.MoveNext
Loop

strMsg = "Tables linked successfully."

rst.Close
Set rst = Nothing
Set tdf = Nothing
Set db = Nothing

ExitHere:
MsgBox strMsg, , "Link SQL Tables"
Exit Sub

HandleErr:
Select Case Err
Case Else
strMsg = Err & ": " & Err.Description
Resume ExitHere
End Select

End Sub

I have created an access table called: tblSQLTables and added the name of the table I want to relink in it. That linked table exists in my current access app.

The code runs until line "strServer = rst!SQLServer" then it jumps to: "Select Case Err" and I get the following error message: 3265: Item not found in this collection

Could someone help me understand the error. Is this a bad connection to the database or to the linked table?

Thank you for any input!
 
To follow up with my question,

After the code goes over:

Set rst = db.OpenRecordset("tblSQLTables", dbOpenSnapshot)

rst is not getting the name of the server or the database. Could this be the issue?

Thank you!
 
I have some code to link all the tables in an App. Would you like to try it.
 
That would be greatly appreciated!
 
This reads sql server and finds the User tables in the schema and links to the app. If you have Northwinds on the sql server then make necessary changes and test.

'-- set reference to ADOX library
'- Microsoft ADO Ext. 2.6 for DDL and Security

Public Function AddLinkedTablesLooper()
Dim sConnString As String
Dim rs1 As New ADODB.Recordset
Dim tabName As String

' Create a new Table object
Set rs1 = GetSqlServerTables
rs1.MoveFirst
tabName = rs1!Name

While Not rs1.EOF
Call AddSQLServerLinkedTables(tabName)
rs1.MoveNext
If Not rs1.EOF Then
tabName = rs1!Name
End If
Wend

Set rs1 = Nothing

End Function

Public Function GetSqlServerTables() As ADODB.Recordset
Dim cn As New ADODB.Connection, sql1 As String
Dim rs As New ADODB.Recordset, connString As String
Dim Myarr(50) As String, indx As Integer, maxindx As Integer
connString = "provider=SQLOLEDB.1;" & _
"User ID=sa;Initial Catalog=northwind;" & _
"Data Source=localhost;" & _
"Persist Security Info=False"

''Set cn = CurrentProject.Connection
cn.ConnectionString = connString
cn.Open
sql1 = "select name from dbo.sysobjects where xtype = 'U'"

rs.Open sql1, cn, adOpenStatic, adLockReadOnly

If rs.EOF And rs.BOF Then
MsgBox "No sql server tables returned"
Set rs = Nothing
Exit Function
End If

rs.MoveFirst
indx = 0
While Not rs.EOF
Myarr(indx) = rs!Name
indx = indx + 1
rs.MoveNext
Wend
maxindx = indx - 1
For indx = 0 To maxindx
Debug.Print "table name = "; Myarr(indx)
Next
Set GetSqlServerTables = rs
Set rs = Nothing
End Function

Public Function AddSQLServerLinkedTables(tabName As String)
Dim oCat As ADOX.Catalog
Dim oTable As ADOX.Table
Dim sConnString As String
On Error GoTo Errhandler
' Set SQL Server connection string used in linked table.
sConnString = "ODBC;" & _
"Driver={SQL Server};" & _
"Server={localhost};" & _
"Database=Northwind;" & _
"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

Set oTable.ParentCatalog = oCat

With oTable
Debug.Print "loop = "; tabName
.Name = "NW_" & tabName
.Properties("Jet OLEDB:Create Link") = True
.Properties("Jet OLEDB:Remote Table Name") = tabName
.Properties("Jet OLEDB:Link Provider String") = sConnString
End With
' Add Table object to database

oCat.Tables.Append oTable
oCat.Tables.Refresh

Set oCat = Nothing
Set oTable = Nothing
Exit Function

Errhandler:
Dim er As ADODB.Error
Debug.Print " In Error Handler "; Err.description & vbCrLf
For Each er In CurrentProject.Connection.Errors
Debug.Print "err num = "; Err.Number
Debug.Print "err desc = "; Err.description
Debug.Print "err source = "; Err.Source
Debug.Print "connection state = "; CurrentProject.Connection.state
Next

End Function

 
Thank you cmmrfrds for your code sample!

I have a question about the second function GetSqlServerTables.

When I add this function as "Public Function GetSqlServerTables() As ADODB.Recordset" I get the following error:

User Defined type not defined.

When I add the function but remove "As ADODB.Recorset" it doesn't give me an error. I did add Microsoft ADO Ext.2.8 for DDL and Security as instructed. Am I mssing anything else?

Thank you!
 
It uses an ADO recordset.

Your App probably does not have a reference to an ADO library.

Microsoft ActiveX data objects 2.6 library needed for ADO

It could be 2.7 or 2.8 on your PC anyway pick one.
 
you should references the Microsoft ActiveX Data Object Library too.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
Thank you cmmrfrds. That was it! I will keep working on the code to implemented into my project.

Regards!
 
cmmrfrds, Thank you for your help thusfar. I'm stepping thru the code and I get to the point where I'm going thru the tables in Function GetSqlServerTables():

While Not rs.EOF
Myarr(indx) = rs!Name
indx = indx + 1
rs.MoveNext
Wend

There are a total of 58 tables that this code should go thru. However it gets to record 51 and I get the error message: "Runtime error 9 - Subscript out of Range. When I set my cursor over Myarr it tells me <subscript out of range>. Also rs.EOF = False.

Any ideas as to why this error might be generated? Thank you!



 
Please disregard my previous message. I understand that the code you sent me sets:

Dim Myarr(50) As String

I will increase this number to allow for the remaining tables.

Thank you!
 
Hello again... I'm to the point of adding the tables to my access app. However after line:

oCat.Tables.Append oTable

the cursor jumps to Errhandler and I get the following message in the Immediate window:

"Could not find installable ISAM"

I amgine the error comes from my SQL connection string. Is this true?

My SQL connection string is:

sConnString = "Driver={SQL Server};Server=ServerName;Database=DatabaseName;Trusted_Connection=yes;"

 
Just to make sure I explain all details, I have added the above connection string to both GetSqlServerTables and AddSQLServerLinkedTables Functions. Is this correct?

Thank you!
 
I figured it out:

I had my connection string wrong as I expected in Function AddSQLServerLinkedTables:

sConnString = "ODBC;" & _
"Driver={SQL Server};" & _
"Server={localhost};" & _
"Database=Northwind;" & _
"Uid=sa;" & _
"Pwd=;"

It works great! Thank you cmmrfrds!
 
Great! I am glad you got it to work. Good job in correcting the errors you found.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top