'//Name : AttachDSNLessTable
'//Purpose : Create a linked table to SQL Server without using a DSN
'//Parameters
'// stLocalTableName: Name of the table that you are creating in the current database
'// stRemoteTableName: Name of the table that you are linking to on the SQL Server database
'// stServer: Name of the SQL Server that you are linking to
'// stDatabase: Name of the SQL Server database that you are linking to
'// stUsername: Name of the SQL Server user who can connect to SQL Server, leave blank to use a Trusted Connection
'// stPassword: SQL Server user password
'//Important Notes
'//There are two tables in the front end, these tables contain the server side name and linked name of all SQL Tables linked
'//to database, one is the primary table pointing to the primary server, the other is a secondary server in the event the primary is down
'//the tables links are refreshed every time the FE Loads, if tables are added or removed the appropriate changes need to be noted
'//in the two tables hcc_PrimarySQL and hcc_tblSecondarySQL and the version number updated so clients update when they are opened.
Function AttachDSNLessTable(stLocalTableName As String, stRemoteTableName As String, stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String)
On Error GoTo AttachDSNLessTable_Err
Dim td As TableDef
Dim stConnect As String
For Each td In CurrentDb.TableDefs
If td.Name = stLocalTableName Then
CurrentDb.TableDefs.Delete stLocalTableName
Sleep 50
Exit For
End If
Next
If Len(stUsername) = 0 Then
'//Use trusted authentication if stUsername is not supplied.
stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes"
Else
'//WARNING: This will save the username and the password with the linked table information.
stConnect = "ODBC;DRIVER=SQL Server Native Client 11.0;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword
End If
Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect)
CurrentDb.TableDefs.Append td
AttachDSNLessTable = True
AttachDSNLessTable_Exit:
Exit Function
AttachDSNLessTable_Err:
AttachDSNLessTable = False
DoCmd.Hourglass False
MsgBox "Attempts to connect to SQL Server failed. The system returned the following error: " & Chr(13) & Err.Description & " Error Number: " & Err.Number
Resume AttachDSNLessTable_Exit
End Function
Public Function DSNLessConnect()
On Error GoTo Err_DSNLessConnect
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strLocal As String
Dim strsql As String
Dim strServer As String
Dim strDatabase As String
Set db = CurrentDb
Set rs = db.OpenRecordset("hcc_tblPrimarySQL")
rs.MoveFirst
strLocal = rs!LocalTable
strsql = rs!SQLTable
strServer = rs!Server
strDatabase = rs!Database
'Check to see if we are connected to the primary server.
If AttachDSNLessTable(strLocal, strsql, strServer, strDatabase, "", "") Then
'We are connected so we will refreshall the tables
rs.MoveNext
Do Until rs.EOF
If rs!NeedsRefreshed = True Then
strLocal = rs!LocalTable
strsql = rs!SQLTable
strServer = rs!Server
strDatabase = rs!Database
Call AttachDSNLessTable(strLocal, strsql, strServer, strDatabase, "", "")
With rs
.Edit
!NeedsRefreshed = False
.Update
.MoveNext
End With
Else
rs.MoveNext
End If
Loop
Else
'// Not okay.We will try the secondary database
Dim rsAlt As DAO.Recordset
Set rsAlt = db.OpenRecordset("hcc_tblSecondarySQL")
rsAlt.MoveFirst
strLocal = rsAlt!LocalTable
strsql = rsAlt!SQLTable
strServer = rsAlt!Server
strDatabase = rsAlt!Database
If AttachDSNLessTable(strLocal, strsql, strServer, strDatabase, "", "") Then
'We have connection to secondary Database
MsgBox "The primary database " & rs!Server & " is not connecting, please contact sys admin." & Chr(13) _
& "Connecting to backup server!", vbOKOnly, "Connection Error"
rsAlt.MoveNext
Do Until rsAlt.EOF
If rsAlt!NeedsRefreshed = True Then
strLocal = rsAlt!LocalTable
strsql = rsAlt!SQLTable
strServer = rsAlt!Server
strDatabase = rsAlt!Database
Call AttachDSNLessTable(rsAlt!LocalTable, rsAlt!SQLTable, rsAlt!Server, rsAlt!Database, "", "")
With rsAlt
.Edit
!NeedsRefreshed = False
.Update
.MoveNext
End With
Else
rsAlt.MoveNext
End If
Loop
Else
On Error Resume Next
DoCmd.Hourglass False
'Could not connect to either database, catastrophic error, close program after notifying user
MsgBox "No Connection can be made to primary or backup database, please notify sys admin."
DoCmd.Quit
End If
End If
Exit_DSNLessConnect:
On Error Resume Next
db.Close
rs.Close
rsAlt.Close
Set db = Nothing
Set rs = Nothing
Set rsAlt = Nothing
strLocal = ""
strsql = ""
strServer = ""
strDatabase = ""
Exit Function
Err_DSNLessConnect:
DoCmd.Hourglass False
MsgBox "An Error Occurred in the DSNLessConnect Function; Module: hcc_modDSNLessConnection " & _
vbCr & vbCr & "Error Number: " & Err.Number & vbCr & vbCr & "Error Desc: " & Err.Description, vbInformation, "PLEASE TAKE A SCREENSHOT OF THIS ERROR!"
Resume Exit_DSNLessConnect
End Function
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.
Our community of experts have been thoroughly vetted for their expertise and industry experience.
The Fellow title is reserved for select members who demonstrate sustained contributions, industry leadership, and outstanding performance. We will announce the experts being inducted into the Experts Exchange Fellowship during the annual Expert Awards, but unlike other awards, Fellow is a lifelong status. This title may not be given every year if there are no obvious candidates.
The Most Valuable Expert award recognizes technology experts who passionately share their knowledge with the community, demonstrate the core values of this platform, and go the extra mile in all aspects of their contributions. This award is based off of nominations by EE users and experts. Multiple MVEs may be awarded each year.