Error Trap Connection to SQL server

R

rob

I am trying to establish links from Ms Access to tables in a SQL server
database. There is an Access

table (tblLinkMaster) that contain all the required linkage information. If
the database is attached

and the network connection is good, the code below works fine and all is
well with the world.

However, when I detach the database and test to see what the user would see,
I get... Connection

failed: SQLSTATE:'08004' SQL Server Error: 4060 Server rejected the
connection; Access to selected

databse has been denied. If I then click OK and cancel, the program errors
out in a messy manner.

(Program stops HERE
' Then get new link info
db1.Execute ("qapptblLinkTable"))

If the database is not available, I would prefer that the whole procedure
stop and exit gracefully.

Any Ideas on how this can be error trapped nicely ?

Thanks !


Function GetMasterLinkData()
' Based on Data in Local table (entered via form) - tblLinkMaster /
qrytblLinkMaster
Dim db1 As DAO.Database
Dim rs1 As DAO.Recordset
Set db1 = CurrentDb()
Set rs1 = db1.OpenRecordset("qrytblLinkMaster")

Dim strLinkName As String
Dim strDBName As String
Dim strTableName As String
Dim strDSNname As String
Dim strServerName As String

rs1.MoveFirst
If IsNull(rs1!LinkName) Or rs1!LinkName = "" Or _
IsNull(rs1!DatabaseName) Or rs1!DatabaseName = "" Or _
IsNull(rs1!TableName) Or rs1!TableName = "" Or _
IsNull(rs1!ServerName) Or rs1!ServerName = "" Then
MsgBox ("The Initial Set-up Infromation Is Incomplete - Please contact
an Administrator")
Exit Function
Else
strLinkName = rs1!LinkName
strDBName = rs1!DatabaseName
strTableName = rs1!TableName
strDSNname = ""
strServerName = rs1!ServerName
Call LinkTableDAO(strLinkName, strDBName, strTableName, strDSNname,
strServerName)

End If

' Now remove previous link info
db1.Execute ("DELETE from tblLinkTable")

' Then get new link info
db1.Execute ("qapptblLinkTable")

rs1.Close
Set rs1 = Nothing
db1.Close
Set db1 = Nothing

End Function


Public Function LinkTableDAO(strLinkName As String, strDBName As String,
strTableName As String,

strDSNname As String, strServerName As String)

Dim db As DAO.Database
Dim tdf As DAO.TableDef

On Error Resume Next
Set db = CurrentDb
' if link pre-exists, then delete it
Set tdf = db.TableDefs(strLinkName)
If Err.Number = 0 Then
' Found an existing tabledef
db.TableDefs.Delete strLinkName
db.TableDefs.Refresh
Else
' No existing tabledef
' Ignore error and reset
Err.Clear
End If

' Create a new TableDef object
Set tdf = db.CreateTableDef(strLinkName)
' set connect and source table table name prperties to establish link
tdf.Connect = "ODBC;Driver={SQL Server};Server=" & strServerName &
";Database=" & strDBName &

";Trusted_Connection=Yes"
tdf.SourceTableName = strTableName

' Append to the database's TableDefs collection
' IF SQL SERVER DB NOT ATTACHED - THEN ERROR OCCURS HERE
db.TableDefs.Append tdf

db.Close

End Function
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top