How much do you know about DSN-less connections. I don't know if this is your problem or not but if you do not want to use an ODBC definition (either system or user) you can re-establish links to a SQL server without having one.
Example:
FT_ID |
ForeignTable |
1 |
SQLTable1 |
2 |
SQLTable2 |
3 |
SQLTable3 |
DB_ID |
DB_Server |
DB_Name |
DB_User |
DB_Password |
DB_Description |
DB_Current |
|
9 |
DBServerName1 |
DBName |
UserName |
*** |
SourceDB1 |
Yes |
|
13 |
DBServerName2 |
DBName2 |
Username2 |
*** |
SourceDB2 |
No |
|
In this example there's a combo box on my welcome screen listing the most recent database to which I was attached (I have test/production servers listed in my tblDBList table both of which have the same table structure and table names)
cboCurrentServer is the name of the combo box holding the most recent (or selected) database.
Code:
If DCount("*", "tblDBList", "[DB_Current] = -1") > 0 Then cboCurrentServer = DLookup("[DB_ID]", "tblDBList", "[DB_Current] = -1")
sServer = Forms("frmMain").Controls("cboCurrentServer").Column(3)
sDatabase = Forms("frmMain").Controls("cboCurrentServer").Column(4)
sUser = Forms("frmMain").Controls("cboCurrentServer").Column(5)
sPW = Forms("frmMain").Controls("cboCurrentServer").Column(6)
TestConn = TestConnection(sServer, sDatabase, sUser, sPW)
If Len(TestConn) = 0 Then
ReturnValue = RELINK(sServer, sDatabase, sUser, sPW, 0)
If Len(ReturnValue) > 0 Then
MsgBox "The following tables were not found in the database:" & vbCrLf & vbCrLf & ReturnValue, vbOKOnly, "Tables not Found"
End If
Else
MsgBox TestConn, vbOKOnly, "Selected Database is Invalid"
End If
Else
MsgBox "No Default Database Selected" & vbCrLf & vbCrLf & "Please select a database and click 'RELOAD SELECTED DATABASE", vbOKOnly, "No Default Database"
End If
Functions called in this
Code:
Public Function RELINK(sServer, sDatabase, sUser, sPassword, iLink)
Dim dbCurrent As dao.Database
Dim rstTables As dao.Recordset
Dim sTable As String
Dim tdfCurrent As dao.TableDef
Dim sErrMsg As String
On Error GoTo ERRHANDLER
sConnStr = "ODBC;DRIVER={SQL Server};DATABASE=" & sDatabase & ";SERVER=" & sServer & ";UID=" & sUser & ";PWD=" & sPassword & ";"
Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
Set rstTables = CurrentDb.OpenRecordset("SELECT * FROM tblGOSHTables ORDER BY GOSHTable")
Do While rstTables.EOF <> True
sTable = rstTables!GOSHTable
fldStatus = "Importing " & sTable & "..." & vbCrLf
DoEvents
If DCount("[name]", "MSysObjects", "[Name] = 'dbo_" & sTable & "'") = 0 Then
'do whatever if the table does not exist adding the table is coded below
Else
CurrentDb.Execute ("DROP TABLE dbo_" & sTable)
End If
If iLink = 0 Then
Set tdfCurrent = dbCurrent.CreateTableDef("dbo_" & sTable)
tdfCurrent.Connect = sConnStr
tdfCurrent.SourceTableName = sTable
dbCurrent.TableDefs.Append tdfCurrent
Else
DoCmd.TransferDatabase acImport, "ODBC Database", sConnStr, acTable, sTable, "dbo_" & sTable
End If
HideTable ("dbo_" & sTable)
rstTables.MoveNext
Loop
Application.RefreshDatabaseWindow
rstTables.Close
Set tdfCurrent = Nothing
Set dbCurrent = Nothing
fldStatus = Null
RELINK = sErrMsg
Exit Function
ERRHANDLER:
Debug.Print Err.Number & " " & Err.Description
If Err.Number = 3011 Then
sErrMsg = sErrMsg & sTable & vbCrLf
Resume Next
Else
End If
End Function
Public Function TestConnection(sServer, sDatabase, sUser, sPassword)
Dim cnn As Object
On Error GoTo ERRHANDLER
Set cnn = CreateObject("ADODB.Connection")
sConnStr = "Provider=SQLOLEDB;" & _
"Server=" & sServer & ";" & _
"Initial Catalog=" & sDatabase & ";" & _
"UID=" & sUser & ";" & _
"PWD=" & sPassword & ";"
'Debug.Print sConnStr
cnn.Open (sConnStr)
If cnn.State = adStateOpen Then
cnn.Close
TestConnection = ""
Set cnn = Nothing
Exit Function
Else
End If
Set cnn = Nothing
Exit Function
ERRHANDLER:
Debug.Print Err.Number & " " & Err.Description
'MsgBox "The connection failed:" & vbCrLf & vbCrLf & "ERROR NUMBER: " & vbCrLf & Err.Number & vbCrLf & vbCrLf & "ERROR DESCRIPTION: " & vbCrLf & Err.Description, vbOKOnly, "Connection Failed"
TestConnection = "The connection to the server \\" & sServer & "\" & sDatabase & " failed" & vbCrLf & vbCrLf & "ERROR NUMBER: " & vbCrLf & Err.Number & vbCrLf & vbCrLf & "ERROR DESCRIPTION: " & vbCrLf & Err.Description & vbCrLf & vbCrLf & "Please Select a different server or check your connections"
End Function