Check for presence of an SQL Server (1 Viewer)

JohnPapa

Registered User.
Local time
Today, 21:39
Joined
Aug 15, 2010
Messages
1,037
If any of the Connection parameters to the SQL Server is wrong then I get prompted to enter the SQL server password.

Is there a way to check for the presence of the SQL Server without the user being prompted for the password.

I use a DSNless connection from A365 to SQL Server Express and the following code creates linked tables for all the tables stored in tblTableList

Code:
'Go through all tables in tblTableList
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst.Open "tblTableList", CurrentProject.Connection, adOpenKeyset, adLockPessimistic


If rst.BOF And rst.EOF Then


Else
  
    rst.MoveFirst
    Do While Not (rst.EOF)
        'Need Server name, Username, Password
        stConnect = "ODBC;DRIVER=ODBC Driver 17 for SQL Server;SERVER=" & strServerWithPathname & ";UID=" & strUsername & ";Trusted_Connection=No;" _
        & "APP=Microsoft Office;DATABASE=VF3;PWD=" & strPassword & ";TABLE=" & rst!strFETable & ""
        Set tdf = CurrentDb.CreateTableDef(rst!strFETable, dbAttachSavePWD, rst!strBETable, stConnect)
        CurrentDb.TableDefs.Append tdf
        rst.MoveNext
    Loop
End If
 
These are the two annoying messages I get

1703248439184.png




1703248517106.png
 
I think you will struggle with this a little, as to check you are connected you need to try and connect....

Assuming you have one table already linked (tblTableList?) you can do something like

Code:
Function IsODBCConnected(TableName As String) As Boolean

   Set rst = CurrentDb.OpenRecordset(TableName, dbOpenSnapshot)
   IsODBCConnected = (Err.Number <> 3151)

End Function
 
I think you will struggle with this a little, as to check you are connected you need to try and connect....

Assuming you have one table already linked (tblTableList?) you can do something like

Code:
Function IsODBCConnected(TableName As String) As Boolean

   Set rst = CurrentDb.OpenRecordset(TableName, dbOpenSnapshot)
   IsODBCConnected = (Err.Number <> 3151)

End Function
Chicken and egg situation! The check should be done prior to linking any tables.
 
Perhaps you can create a function like:
Code:
Function IsSQLServerAvailable(strCn AS String) As Boolean
On Error Resume Next

  With CreateObject("ADODB.Connection")
    .ConnectionString = strCn
    .CursorLocation = 3    ' adUseClient
    .Open
    If .State = 1 Then     ' adStateOpen
      IsSQLServerAvailable = True
      .Close
    End If
  End With

End Function
Then you can use the function:
Code:
Dim strCn As String

strCn = "ODBC; ..."      ' Your connection string here
If IsSQLServerAvailable(strCn) Then
  ' Relink tables code
Else
  ' Oops!
End If
(Nb untested)

Also you could change to catch the errors in the function to see what the problem is.
 
Perhaps you can create a function like:
Code:
Function IsSQLServerAvailable(strCn AS String) As Boolean
On Error Resume Next

  With CreateObject("ADODB.Connection")
    .ConnectionString = strCn
    .CursorLocation = 3    ' adUseClient
    .Open
    If .State = 1 Then     ' adStateOpen
      IsSQLServerAvailable = True
      .Close
    End If
  End With

End Function
Then you can use the function:
Code:
Dim strCn As String

strCn = "ODBC; ..."      ' Your connection string here
If IsSQLServerAvailable(strCn) Then
  ' Relink tables code
Else
  ' Oops!
End If
(Nb untested)

Also you could change to catch the errors in the function to see what the problem is.
I tried your suggestion. It is telling me that it is not available

Code:
Function IsSQLServerAvailable(strCn As String) As Boolean
On Error Resume Next


  With CreateObject("ADODB.Connection")
    .ConnectionString = strCn
    .CursorLocation = 3    ' adUseClient
    .Open
    If .State = 1 Then     ' adStateOpen
      IsSQLServerAvailable = True
      .Close
    End If
  End With


End Function


Private Sub Command80_Click()
Dim strCn As String


strCn = "ODBC;DRIVER=ODBC Driver 17 for SQL Server;SERVER=DESKTOP-KQTNJ42\SQLEXPRESS;UID=savf;Trusted_Connection=No;APP=Microsoft Office;DATABASE=VF3;PWD=1234"
If IsSQLServerAvailable(strCn) Then
  ' Relink tables code
  MsgBox ("Available")
Else
  ' Oops!
  MsgBox ("Not Available")
End If
End Sub
 
Have you taken any steps to debug the problem?
I have tried specifying a table in the connection string, different dbs. Have tried other code which I found on the Internet.
There is not much I can do, if the connection string works.
 
Try commenting out the OnError statement - it could be hiding something
 
Also see if adding curly brackets around your driver value helps:
Code:
strCn = "ODBC;DRIVER={ODBC Driver 17 for SQL Server};SERVER=DESKTOP-KQTNJ42\SQLEXPRESS;UID=savf;Trusted_Connection=No;APP=Microsoft Office;DATABASE=VF3;PWD=1234"
Sometimes spaces in the values can cause issues.
 
One more thing: are you using 32bit Access?

If so, you may need to add an extra Key-Value pair to your connection string:
Code:
strCn = "ODBC;PROVIDER=MSDASQL;DRIVER={ODBC Driver 17 for SQL Server};" & _
        "SERVER=DESKTOP-KQTNJ42\SQLEXPRESS;UID=savf;Trusted_Connection=No;" & _
        "APP=Microsoft Office;DATABASE=VF3;PWD=1234"
 
Here's a revised version of the function (plus a helper function) - give it a try:
Code:
Function IsDBServerAvailable(strCn As String) As Boolean
On Error GoTo Err_IsDBServerAvailable

  Const adUseClient As Integer = 3, _
        adStateOpen As Integer = 1, _
        ODBC As String = "ODBC;", _
        PROVIDER As String = "PROVIDER=MSDASQL;"
        
  If Is32BitAccess Then
    If InStr(strCn, PROVIDER) = 0 Then
      strCn = Replace(strCn, ODBC, ODBC & PROVIDER)
    End If
  End If

  With CreateObject("ADODB.Connection")
    .ConnectionString = strCn
    .CursorLocation = adUseClient
    .Open
    If .State = adStateOpen Then
      IsDBServerAvailable = True
      .Close
    End If
  End With

Exit_IsDBServerAvailable:
  Exit Function

Err_IsDBServerAvailable:
  Select Case Err.Number
  Case Else
    MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & _
           "Description: " & Err.Description & vbNewLine & vbNewLine & _
           "Function: IsSQLServerAvailable" & vbNewLine & _
           IIf(Erl, "Line No: " & Erl & vbNewLine, "") & _
           "Module: " & Application.VBE.ActiveCodePane.CodeModule.Name, , _
           "Error: " & Err.Number
  End Select
  Resume Exit_IsDBServerAvailable

End Function

Function Is32BitAccess() As Boolean

  Dim bl32bit As Boolean
 
  #If Win64 Then
    bl32bit = False
  #Else
    bl32bit = True
  #End If
  Is32BitAccess = bl32bit

End Function
Then you need:
Code:
Private Sub Command80_Click()
  Dim strCn As String

  strCn = "ODBC;DRIVER=ODBC Driver 17 for SQL Server;SERVER=DESKTOP-KQTNJ42\SQLEXPRESS;UID=savf;Trusted_Connection=No;APP=Microsoft Office;DATABASE=VF3;PWD=1234"
  If IsSQLServerAvailable(strCn) Then
  ' Relink tables code
    MsgBox ("Available")
  Else
  ' Oops!
    MsgBox ("Not Available")
  End If
End Sub
 
Also see if adding curly brackets around your driver value helps:
Code:
strCn = "ODBC;DRIVER={ODBC Driver 17 for SQL Server};SERVER=DESKTOP-KQTNJ42\SQLEXPRESS;UID=savf;Trusted_Connection=No;APP=Microsoft Office;DATABASE=VF3;PWD=1234"
Sometimes spaces in the values can cause issues.
Same error message as above
 
One more thing: are you using 32bit Access?

If so, you may need to add an extra Key-Value pair to your connection string:
Code:
strCn = "ODBC;PROVIDER=MSDASQL;DRIVER={ODBC Driver 17 for SQL Server};" & _
        "SERVER=DESKTOP-KQTNJ42\SQLEXPRESS;UID=savf;Trusted_Connection=No;" & _
        "APP=Microsoft Office;DATABASE=VF3;PWD=1234"
Yes I am using 32-bit.

It worked with the addition of "PROVIDER=MSDASQL"

I changed the db from VF3 (which exists) to VF4 (which does not exist) and I get the following error

1703329106391.png
 
I added the On Error (see 1) and empty Error Handler (see 2) and it works fine and executes (see 3)

1703329681213.png
 
Yes it works and I will also check the new code you sent over, to which I may need to add the Provider.
Many thanks.
The new code adds the provider automatically if it detects 32bit Access and it's not present in the connection string
 

Users who are viewing this thread

Back
Top Bottom