How to code to link all SQL server tables via odbc?
- Thread starter aspfun
- Start date
And then once you have them linked to update them you could use something like this. This is what I use for SQL Server. It does not require a DNS.
You simply call RelinkAllTables.
Only call this to refresh tables it will not add new tables, but you could add new ones if you change th code.
I had to delete my error message stuff when the connection times out so YOU WILL have to fix that part up. I have left a lot there. It first checks for 30 seconds then a further 20.
Code:
Option Compare Database
Option Explicit
Public gcnn As ADODB.Connection
Public Const LUT_PROVIDER As String = "SQLOLEDB.1"
'Public Const LUT_PROVIDER As String = "MSDASQL"
Public Const LUT_DATA_SOURCE As String = ""
Public Const LUT_INITIAL_CATALOG As String = ""
Public Const LUT_USER_ID As String = "" 'username
Public Const LUT_PASSWORD As String = "" Password
Public Function OpenConnection() As Boolean
'This is for the opening of a global ADO connection
On Error GoTo HandleError
Dim boolState As Boolean
Dim bln_error As Boolean
Dim Response As String
If gcnn Is Nothing Then
Set gcnn = New ADODB.Connection
End If
If gcnn.State = adStateOpen Then
boolState = True
Else
gcnn.ConnectionString = "Driver={SQL SERVER};Server=" & LUT_DATA_SOURCE & ";" & _
"Database=" & LUT_INITIAL_CATALOG & ";UID=" & LUT_USER_ID & ";PWD=" & LUT_PASSWORD & "
'set up errors
On Error Resume Next
'open the connection with the standard 15second timeout
gcnn.Open
'if there is no connection then this will be the error number
If Err.Number = -2147467259 Then
Err.Clear
'here deal with timeout eg ask if they want to continue
'I had to delete my stuff here that would not work for you.
IF "YES" then
gcnn.ConnectionTimeout = 20 'change to 20 seconds
gcnn.Open
'second attempt also failed so close
If Err.Number = -2147467259 Then
Application.Quit
End If
'user does not want to try again so exit application
Else
' MsgBox ProfileGetItem(strlanguage, "gcnn_err_F", sDefValue, sInifile) & vbNewLine & vbNewLine & _
' ProfileGetItem(strlanguage, "gcnn_err_G", sDefValue, sInifile), vbInformation, "No Siemens Server"
' Application.Quit
End If
Else
'if it is not a network problem then call a general error
GoTo HandleError
End If
If bln_error Then
'waiting_form_text False
'waiting_form False
DoEvents
DoEvents
bln_error = False
End If
If gcnn.State = adStateOpen Then
boolState = True
End If
End If
OpenConnection = boolState
ExitHere:
Exit Function
HandleError:
OpenConnection = False
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
Resume ExitHere
End Function
Public Function RelinkAllTables(Optional strSQLDB As String) As Boolean
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim fLink As Boolean
On Error GoTo HandleErr
'Open the catalog
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
For Each tbl In cat.Tables
With tbl
'Only process linked ODBC tables
If .Type = "PASS-THROUGH" Then
fLink = LinkTableADOX(strLinkName:=.Name, strTableName:=.Properties("Jet OLEDB:Remote Table Name"))
'If theres a problem linking one table, then don't bother processing the rest.
If Not fLink Then GoTo ExitHere
End If
End With
Next tbl
RelinkAllTables = fLink
ExitHere:
Set cat = Nothing
Exit Function
HandleErr:
RelinkAllTables = False
MsgBox Prompt:=Err & ": " & Err.Description, title:="Error in RelinkAllTables"
Resume ExitHere
End Function
Public Function LinkTableADOX(strLinkName As String, strTableName As String) As Boolean
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
On Error Resume Next
'Point the catalog to the current database
cat.ActiveConnection = CurrentProject.Connection
'if the link already exists, delete it
Set tbl = cat.Tables(strLinkName)
If Err = 0 Then
cat.Tables.Delete strLinkName
Else
Err = 0
End If
'Set the name and parent catalog for the link
tbl.Name = strLinkName
Set tbl.ParentCatalog = cat
'set the properties to create the link
tbl.Properties("Jet OLEDB:Create Link") = True
tbl.Properties("Jet OLEDB:Link Provider String") = "ODBC;Driver={SQL Server}; Server=" & LUT_DATA_SOURCE & ";Database=" & LUT_INITIAL_CATALOG & "; UID=" & LUT_USER_ID & ";PWD=" & LUT_PASSWORD
tbl.Properties("Jet OLEDB:Remote Table Name") = strTableName
tbl.Properties("Jet OLEDB:Cache Link Name/Password") = dbAttachSavePWD
'Append the table to the collection
cat.Tables.Append tbl
Set cat = Nothing
LinkTableADOX = (Err = 0)
End FunctionMost of this comes from "Microsoft Access's Developers Guide to SQL Server"
LOL I think they understand each other
Interesting. I wonder why it's not NDA.
Agreed that is not good. Sorry
The code I gave you does only deal with linked tables, cause it checks first. I think with a little modification you could do away with the checking if it is linked and just link by table name.
Similar threads
