The code is pretty simple:
Code:
Function gfnDSNSelect()
Dim wrk As Workspace
Dim db As Database
On Error GoTo Err_gfnDSNSelect
Set wrk = DBEngine.CreateWorkspace("NewODBCWorkspace", "admin", "", dbUseJet)
DoCmd.SetWarnings False
'**** this is the relevant line of code
Set db = wrk.OpenDatabase("", False, False, "ODBC;UID=bla;PWD=blabla;")
DoCmd.SetWarnings True
'do stuff with the connection
'Close the workspace and connection.
'conn.Close
Set db = Nothing
wrk.Close
Exit_gfnDSNSelect:
Exit Function
Err_gfnDSNSelect:
Call gfnErrorLog("gfnDSNSelect - ", Err.Description, Err.Number)
Resume Exit_gfnDSNSelect
End Function
The problem is that the error trapping doesn't stop two popups occurring if the SQL server behind the DSN you select is offline.
I eventually found something that works by searching 'Suppress ODBC connection failure warnings', courtesy of Trevor Best from http://bytes.com/topic/access/answer...nection-dialog
PBaldy, I think you would have found it out eventually, as Trevor wrote some code that uses ADO to make the database connection (like you do) which apparently allows VBA error trapping to catch the error before the system throws any popups at you.
Code:
Function CanOpenSQLDbLB(pstrServer As String, pstrDb As String, pstrUser
As String, pstrPassword As String, Optional pfReportError As Boolean =
True) As Boolean
On Error GoTo CanOpenSQLDbLB_Err
Dim objConn As Object
Dim strConn As String
Dim strError As String, lngErr As Long
Const cstrSQLErr = "[Microsoft][ODBC SQL Server Driver][SQL Server]"
Set objConn = CreateObject("ADODB.Connection")
strConn = strConn & "DRIVER=SQL Server"
strConn = strConn & ";SERVER=" & pstrServer
strConn = strConn & ";APP=" & Application.Name
strConn = strConn & ";WSID=AWorkstation"
strConn = strConn & ";DATABASE=" & pstrDb
objConn.Open strConn, pstrUser, pstrPassword
CanOpenSQLDbLB = True
CanOpenSQLDbLB_Exit:
On Error Resume Next
objConn.Close
Set objConn = Nothing
Exit Function
CanOpenSQLDbLB_Err:
lngErr = Err.Number
strError = Err.Description
If InStr(1, strError, cstrSQLErr) Then
strError = "Error reported by server" & vbCr & vbCr &
Replace(strError, cstrSQLErr, "")
End If
Select Case lngErr
Case Else
If pfReportError Then
MsgBox strError, 16, "Error #" & Err & " Attempting to
open server database"
End If
End Select
Resume CanOpenSQLDbLB_Exit
End Function
Cheers for the responses everyone.