Determine if SQL Server is online

[NauticalGent]

Greetings SQL Ninjas,

I can’t believe Dr. Google could not provide an answer (as quickly as I wanted anyway) and I could not come up with the right search criteria on this forum either. This question HAS to have been asked before so please indulge me on this one.

There are times when the Server is offline when my application starts or either goes offline while users are logged in. Because the error is thrown from the server and not Access, my error handing code does not engage.

What I am looking/asking for is a way to determine if the server is online and if it isn’t, exit the application gracefully before the error from the server pops-up and confuses my users...

Thanks in advance!

 

[isladogs]

Hi NG

Save the following function in a standard module

Public Function CheckSQLServerConnection() As Boolean 

'returns true if SQL Server is running and the listed database is available
'Otherwise false

On Error GoTo Err_Handler

Dim cnn As ADODB.Connection

CheckSQLServerConnection = False

    Set cnn = New ADODB.Connection
   [COLOR="SeaGreen"][B] 'Modify the next line as appropriate[/B][/COLOR]
    cnn.Open "Provider=SQLOLEDB;Data Source=SERVER_NAME;Initial Catalog=SQL_DB_NAME;User ID=USERNAME;Password=PASSWORD"
    
    If cnn.State = adStateOpen Then
        CheckSQLServerConnection = True
        cnn.Close
    End If

    'Debug.Print CheckSQLServerConnection
    
Exit_Handler:
    Exit Function
   
Err_Handler:
    'err = -2147467259 'can't open SQL database - server or database name incorrect or SQLServer not running
    'err = -2147217843 'incorrect UserID / password
    [COLOR="seagreen"][B]'The following is needed if you have an always open form in the background[/B][/COLOR]
    If err = -2147467259 Or err = -2147217843 Then
        DoCmd.Close acForm, "frmLogoutTimer" 'prevents err = 3146 in frmLogoutTimer
    Else
        MsgBox "Error " & err.Number & " in CheckSQLServerConnection procedure : " & vbNewLine & _
            "  " & err.Description & "   ", vbCritical, "SQL Server error"
    End If
    
    Resume Exit_Handler
    
End Function

This should be run as part of startup form Form_Load event. For example

 If CheckSQLServerConnection = False Then
       MsgBox "CRITICAL ERROR: " & vbNewLine & _
        "The database files are not available as SQL Server is not running               " & vbNewLine & _
        CurrentProject.Name & " will now close", vbCritical, "Critical error"
        Application.Quit
    End If

You may also find this function useful:

Function IsSQLServerInstalled() As Boolean 

On Error GoTo Err_Handler

'checks registry to see if SQL Server is installed on this computer

    IsSQLServerInstalled = False

    strText = GetStringValFromRegistry(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Microsoft SQL Server", "IsListenerActive")
    'Debug.Print strText
    If strText <> "" Then IsSQLServerInstalled = True
    
    'Debug.Print IsSQLServerInstalled
    
Exit_Handler:
    Exit Function

Err_Handler:
    MsgBox "Error " & err.Number & " in  IsSQLServerInstalled procedure : " & err.Description
    Resume Exit_Handler
    
End Function

If you use the above you will also need these functions to read the location of SQL Server exe file from the registry. Save in a standard module

Option Compare Database
Option Explicit

'This module is used to grab registry settings through VBA using WMI

Public Enum Hive
  HKEY_CLASSES_ROOT
  HKEY_CURRENT_USER
  HKEY_LOCAL_MACHINE
  HKEY_USERS
  HKEY_CURRENT_CONFIG
End Enum

'#######################################
Public Function GetHive(hivetype As Hive) As Variant
' return enumerated value depending on the hive chosen
  Select Case hivetype
    Case 0
      GetHive = &H80000000  ' HKEY_CLASSES_ROOT
    Case 1
      GetHive = &H80000001  ' HKEY_CURRENT_USER
    Case 2
      GetHive = &H80000002  ' HKEY_LOCAL_MACHINE
    Case 3
      GetHive = &H80000003  ' HKEY_USERS
    Case 4
      GetHive = &H80000005  ' HKEY_CURRENT_CONFIG
  End Select
End Function


Public Function GetStringValFromRegistry(hivetype As Hive, registryKey As String, _
    keyValue As String) As String
    
On Error GoTo ErrHandler:
    
'Checks Any String Value from the Registry
'The function GetStringValFromRegistry takes our custom hive type,
'the registry key to retrieve, and the name of the entry whose value we want to retrieve.
'It also includes another function, GetStdRegProv, which calls the WMI service and returns the appropriate object.

 
Dim objReg As Object
Dim strKeyPath As String
Dim ValueName As String
Dim strValue As String
 
  Set objReg = GetStdRegProv
 
  strKeyPath = registryKey
  ValueName = keyValue
 
  ' put key value into strValue variable
  objReg.GetStringValue GetHive(hivetype), strKeyPath, ValueName, strValue
  GetStringValFromRegistry = strValue
  
Exit_ErrHandler:
    On Error Resume Next
    Exit Function
    
ErrHandler:
    If err.Number >= 0 Then
        MsgBox "Error " & err.Number & ": " & err.Description, vbOKOnly + vbCritical
    End If
    Resume Exit_ErrHandler

 
End Function

Public Function GetStdRegProv() As Object
' http://msdn.microsoft.com/en-us/library/aa394600(VS.85).aspx
Dim strComputer As String
 
  strComputer = "."
 
  Set GetStdRegProv = GetObject("winmgmts:" _
                              & "{impersonationLevel=impersonate}!\\" _
                              & strComputer & "\root\default:StdRegProv")
                              
                              
End Function

 

[NauticalGent]

Thanks Col, this is EXACTLY what I was looking for. I had found similar code online but it was not what is was really looking for.

It seems ADO is the only way to accomplish this? I noticed that the other routines used ADO as well. Not that I am ADO adverse, just an observation...

 

[isladogs]

Glad to have helped.

I've used the code since around 2011 and, as I rarely choose ADO, assume I must have downloaded it from somewhere. No idea where.

The additional code is from a number of different sources. Let me know if you have my issues compiling it

For info, if SQL Server is installed/running, the check only takes a split second. However, it may take a few seconds to complete if not running. You can test it by temporarily stopping the SQL Server service.

 

[jleach]

For me, ADO is preferred for things like this (checking if the server is reachable, initially validating users), typically on startup because once you make a DAO connection, a lot of those DAO connection parameters are cached by Access and not able to be cleared without resetting the Access app. In this regard, ADO can be a little "cleaner" for quick probe operations.

 

[AccessBlaster]

When I see #NAME in all my fields, I just do something else.

 

[NauticalGent]

When I see #NAME in all my fields, I just do something else.

You must not have the Vapor-Lock-At-Every-Error-Message users I have...

 

[arnelgp]

I found this code in the net:

Public Function fncCheckMSSQL()
    Const strComputer As String = "."   'Local Computer
    Dim objWMIService As Variant
    Dim colServices As Variant
    Dim objService As Variant
        
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
        
    Set colServices = objWMIService.ExecQuery _
        ("Select * from Win32_Service where Name = 'MSSQLServer'")
        
    If colServices.Count > 0 Then
        For Each objService In colServices
            Debug.Print "SQL Server is " & objService.State & "."
        Next
    Else
        Debug.Print "SQL Server is not installed on this computer."
    End If
    Set objService = Nothing
    Set colServices = Nothing
    Set objWMIService = Nothing
End Function

 

[NauticalGent]

Interesting choice for variable types. Wonder why they didn’t just use Object and Collection instead of Varient?

 

[AccessBlaster]

You must not have the Vapor-Lock-At-Every-Error-Message users I have...

Creating databases for work is like owning a boat. There are two wonderful moments in a boat owner's life - the day he buys it and the day he sells it.

 

[NauticalGent]

Thanks to all for chiming in, even AccessBlaster!

@ ArnelGP: I tried your code first, only because it was the most simple and did not require me to figure out my connection info. I got the "SQL Server is not installed on this computer." every time. I suspect it is because the code is to see if there is an SQL instance on a local machine, like SQL Express and not an actual server. SWAG as best...

@ Ridders: Your code worked once I got some help from my IT Dept's closest thing to a DBA. Fortunatley enough for me, he likes to solve problems and doesn't just give up. I am going to post what is different:

cnn.Open "Provider=SQLOLEDB.1;" _
&" Persist Security Info=False;" _
& "Integrated Security=SSPI;" _
& "Use Procedure for Prepare=1;" _
& "Auto Translate=True;Packet Size=4096;" _
& "Use Encryption for Data=False;"
& "Tag with column collation when possible=False;" _
& "DATA SOURCE=SEUNAQL50\QL50INST02,1437;" _
& "Initial Catalog=RMC_Tracker;"

To which after talking to him about what each argument did, I was able to reduce down to:

cnn.Open "Provider=SQLOLEDB;" _
& "Integrated Security=SSPI;" _
& "DATA SOURCE=SEUNAQL50\QL50INST02,1437;" _
& "Initial Catalog=RMC_Tracker;"

To gain access to the SQL Server, you must be a member of a distro group, therefore the "Integrated Security=SSPI;" verifies your credentials. For the record, SSPI stands for Security Support Provider Interface.

The rest of the code is as-is with some minor differences in the MsgBox errors my users see.

I had him take it offline to test it and you nailed it; there is a light delay (10 seconds) but it is a much better product now.

Again, thanks to all who weighed in on this, this thread is getting marked as solved!

 

[arnelgp]

have you trid replacing MSSQLServer to your actual server name.

SEUNAQL50

remember it is checking first if the Service is installen on your pc.

 

[NauticalGent]

have you trid replacing MSSQLServer to your actual server name.

SEUNAQL50

remember it is checking first if the Service is installen on your pc.

No, that had not occurred to me to try that. But in the name of research, I will when I get back to work on Thursday.

Taking to day off tomorrow to retrieve the wife from Rome. She took a 2 month vacation back to the states - just because our daughter had a baby. Women...(with apologies to Pat Hartman and Gina Whipp and any others!)

 

[arnelgp]

i am surprised. i thought Pat is a He. you did not mention minty, is she or he?

 

[NauticalGent]

I'll let Minty answer that!

No Pat is definitely a she. The women who represent AWF are quite impressive aren't they?

 

[isladogs]

It shouldn't really matter but Pat is definitely female & Minty is male. OOPS sorry NG

 

[NauticalGent]

It shouldn't really matter but Pat is definitely female & Minty is male. OOPS sorry NG

No worries mate!

 

[isladogs]

NG:
Glad you got it working but surprised you had to make changes to do so.
Its been in regular use for many years at various clients without issues.

 

[NauticalGent]

It's the way our server/network is set up, or so the Half-Baked DBA says any way...