VBA test connection to SQL Server - sql-server

We have multiple SQL servers that our front end connects to. We need a test to check which servers are offline at any one time.
The code below works completely fine with an online SQL server but when testing an offline one takes over 30 seconds to timeout. We need this to timeout much quicker as this is a check that will be run regularly
Function ConTEST()
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
Dim strConnect As String
strConnect = "DRIVER={SQL Server};SERVER=SERVER;UID=UID;PWD=PWD;APP=Microsoft® Windows® Operating System;DATABASE=DB_NAME"
With conn
.ConnectionString = strConnect
.CommandTimeout = 5
.ConnectionTimeout = 5
.Open
End With
End Function
Any suggestions on how to fix this timeout issue would be greatly appreciated.

if it's just a database on the server that is taken offline, then connect to the "master" database in your connection, and run the "DATABASEPROPERTYEX" function to get the status of the database you want to check.
Dim rs As New ADODB.Recordset
With conn
.ConnectionString = strConnect
.CommandTimeout = 5
.ConnectionTimeout = 5
.Open
Set rs = .Execute("select DATABASEPROPERTYEX('yourdb', 'Status') as db_status")
Debug.Print rs(0).Value
.Close
End With
if the entire server is taken offline, you may want to ping the server instead from the command line.

Related

how to connect VBScript (Excel) to SQL Server web database (via IP)

I'm at my job trying to do some unknow stuff for me, you see, we're trying to connect an excel document with a VBScript Macro to a databse stored in web server but for some reason doesn't recognizes the user and throws an error repeatedly, i discarded a connection issue since it returns an SQL error instead of something like a timeout or server doesn't exists or something like that, we're trying to connect to the server using the ip address, we also checked that the logging method is on mixed (win and sql) and remotes connections to the server are enabled as well, also if i use the credentials provided in the connection string (username and password) i can actually log in to SQL Server without any issue, we also tried a direct connection (external vpn) because we thought it could be our firewall, but got the same error anyway, so we have no clue what it could be and we're kinda running out of ideas on how to do this, i'll post down below the code i'm using to trying the connection (obviously test data but similar to reality)
picture of the error i'm getting (don't post the original since it's in spanish but is very similar to this):
code i'm currently trying:
Sub excel_sqlsrv()
Set rs = CreateObject("ADODB.Recordset")
Set conn = CreateObject("ADODB.Connection")
strConn = "Driver={ODBC Driver 17 for SQL Server};Server=10.20.30.5;Database=mydb;UID=sa;PWD=abcd12345;"
conn.Open strConn
strSqL = "SELECT * FROM USERS"
rs.Open strSqL
End Sub
Any advice, tip or trick could be of tremendous help for me, i'll be looking forward to any kind of comment, thanks in advance
Use the ODBC Data Source Administrator to create a connection named mydb and test it works. Then use
Sub excel_sqlsrv()
Const strConn = "mydb" ' ODBC source
Const strsql = "SELECT * FROM USERS"
Dim conn As Object, rs As Object
Set rs = CreateObject("ADODB.Recordset")
Set conn = CreateObject("ADODB.Connection")
On Error Resume Next
conn.Open strConn
If conn.Errors.Count > 0 Then
Dim i, s
For i = 0 To conn.Errors.Count - 1
s = s & conn.Errors(i) & vbLf
Next
MsgBox s
Else
On Error GoTo 0
Set rs = conn.Execute(strsql)
Sheet1.Range("A1").CopyFromRecordset rs
End If
End Sub
You can try using OLEDB provider instead of ADODB.

Connect to SQL Server in VBA if the server requires specific username and password?

I realized today that when you connect to SQL Server data source in Excel's native connection, it doesn't allow you to enter in a specific username and password. It just asks for server name and database.
In VBA , under the assumption that I wanted to import data from a SQL Server data query into Sheet1, can you please help me understand how to write that code?
For purposes of this exercise:
SQL Server Connection INFO
Server Name: TestingS,1633
Database Name: CarSales
username: car
password: sales
The query I want to run for simplicity sake can be: "select * from table"
I have been doing some research , but am getting a bit lost. I have no problem setting up standard queries with custom SQL via ODBC, but because I need VBA, it's very tricky for me. Please help.
This is an example of MSSQL.
Sub testMSSQL()
'Reference Microsoft ActiveX data object Library 2.8 ~~
Dim cnn As ADODB.Connection
Dim strSQL As String
Dim Ws As Worksheet
Set Ws = ActiveSheet
strSQL = "select * from table"
Set cnn = New ADODB.Connection
'Set the provider property to the OLE DB Provider for ODBC.
'cnn.Provider = "MSDASQL"
'cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
'cnn.Provider = "MSOLAP"
cnn.Provider = "SQLOLEDB.1" '<~~ mssql
' Open a connection using an ODBC DSN.
cnn.ConnectionString = "driver={SQL Server};" & _
"server=TestingS;uid=car;pwd=sales;database=CarSales"
Set rs = New ADODB.Recordset
rs.Open strSQL, cnn.ConnectionString, adOpenForwardOnly, adLockReadOnly, adCmdText
cnn.Open
If cnn.State = adStateOpen Then
Else
MsgBox "Not connected server"
Exit Sub
End If
If Not rs.EOF Then
With Ws
.Range("a1").CurrentRegion.ClearContents
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1).Value = rs.Fields(i).Name
Next
.Range("a2").CopyFromRecordset rs
.Columns.AutoFit
End With
Else
MsgBox "No Data!!", vbCritical
End If
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
End Sub

How to secure connection between Vb6 application and mssql server?

I am working on a legacy application which uses sqloledb provider and activex data objects to connect to mssql database. Now I need to encrypt the connection between the application and server without force encryption option in sql server.
I have installed a self signed certificate in the sql server instance and tried putting the Encrypt=true and Trustservercertificate=true in connection string. But the connection is not encrypted.
I have tried using ODBC provider with ADO and while using encrypt=true and trustservercertificate=true, I am getting a SSL security error which opening the connection.
Please let me know how to establish a secure connection using ADO 2.8 library.
Private Sub Command1_Click()
Dim sConnectionString As String
Dim strSQLStmt As String
'-- Build the connection string
'sConnectionString = "UID=userid;PWD=password;Initial Catalog=EHSC_SYM_Kings_Development;Server=EHILP-257\MIB14;Provider=MSOLEDBSQL;Encrypt=YES;trustServerCertificate=YES"
'sConnectionString = "Provider=sqloledb;Data Source=192.168.27.91\MIB14;Initial Catalog=EHSC_SYM_Kings_Development;User Id=userid;Password=password;Encrypt=YES;trustServerCertificate=YES"
'sConnectionString = "driver={SQL Server};server=192.168.27.91\MIB14;user id=userid;password=password;Initial Catalog=EHSC_SYM_Kings_Development;Encrypt=Yes;trustServerCertificate=True"
sConnectionString = "Provider=SQLNCLI11;Server=192.168.27.91\MIB14;Database=EHSC_SYM_Kings_Development;Uid=userid;Pwd=password;Encrypt=yes;trustServerCertificate=True"
strSQLStmt = "select * from dbo.patient where pat_pid = '1001'"
'DB WORK
Dim db As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim result As String
db.ConnectionString = sConnectionString
db.Open 'open connection
With cmd
.ActiveConnection = db
.CommandText = strSQLStmt
.CommandType = adCmdText
End With
With rs
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmd
End With
If rs.EOF = False Then
rs.MoveFirst
Let result = rs.Fields(0)
End If
'close conns
rs.Close
db.Close
Set db = Nothing
Set cmd = Nothing
Set rs = Nothing
End Sub
Thank you all for your suggestions, I finally managed to make the connection secure by changing the driver to sqlserver native client 11(ODBC). Looks like sqloledb doesn't have support for tls. Changing the driver to ODBC doesn't seem to change the behaviour much. Rest of my code works fine without any changes
sConnectionString = "Driver={SQL Server Native Client 11.0};Server=192.168.27.91\MIB14;Database=xxxxxxxx;user id=xxxxxxx;password=xxxxxxxxx;Encrypt=yes;TrustServerCertificate=yes"
Just went through this myself.
For your original connection string the keyword you're looking for is not "Encrypt=true" or "Encrypt=yes" like most of the internet would lead you to believe. It's "Use Encryption for Data=true".
So your connection string becomes:
sConnectionString = "Provider=SQLNCLI11;Server=192.168.27.91\MIB14;Database=EHSC_SYM_Kings_Development;Uid=userid;Pwd=password;Use Encryption for Data=true;trustServerCertificate=True"
The trustservercertificate=true is just for testing with self-signed certs... and exposing yourself to man-in-the-middle attacks ;)
For reference this was tested with:
VB6 connecting to SQL Server 2016 using SQLNCLI11 provider via ADODB.

How do I connect to a new Datasource in Access 2016 VBA?

My department uses an application created using VBA and Access 2016. It originally pointed to an Access database on one of our servers. After migrating the data to a different server, I now need it pointing to the other SQL Server database on that different server. But I can't seem to make the connection.
I have dbowner permissions on the server in question.
The original code for connection string was as follows:
'Remove the filter, close the log on form, and open the Switchboard
rst.Filter = 0
DoCmd.Close acForm, "frmUserLogOn"
'Open the Main Switchboard
DoCmd.OpenForm "frmMain", acNormal
'Open the InactiveShutDown form in Hidden mode
DoCmd.OpenForm "frmInactiveShutDown", acNormal, , , , acHidden
...
Set conn = CurrentProject.Connection
...
rstLog.Open "tblUserLog", conn, adOpenKeyset, adLockOptimistic
rstLog.AddNew
rstLog!UserID = rst!UserID
rstLog!TimeIn = Now()
rstLog.Update
My new code is as follows:
'DoCmd.OpenForm "frmInactiveShutDown", acNormal, , , , acHidden
'Commented out the above statement
...
'Set conn = CurrentProject.Connection
'==================================================================
'Start of Added Code for SQL Migration
Set conn = New ADODB.Connection
With conn
.ConnectionString = "Provider=SQLNCLI11;Data Source=(My Server Name);Initial Catalog=(My Database Name);User ID=(Username);Password=(Password)"
.Open
If .State = adStateClosed Then
MsgBox "Connection unsuccessful. Could not open connection.", vbInformation, "Error:"
End If
End With
Set rst = New ADODB.Recordset
With rst
.ActiveConnection = conn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Open "tbl_Users"
End With
'End of Added Code for SQL Migration - See Section 2 for rest of code.
'==================================================================
...
'Section 2 of Code
'==================================================================
'Start of added code for SQL Migration
rstLog.Open "tblUserLog", conn, adOpenStatic, adLockOptimistic
rstLog.AddNew
rstLog!UserID = rst!UserID
rstLog!TimeIn = DateTime.Now()
rstLog.Update
MsgBox "Success! Connection was made successfully.", vbInformation
'End of added code for SQL Migration
'===================================================================
My form has a drop down to select list of users form a table. I added a test user in that table but that test user doesn't show up in the drop down list. Hence, I think the connection is not being made.
Do I have to enter the names for Data Source, Initial Catalog, User ID and Password in quotes? So UserID='Admin'; Password='Test'?
Anyone know what I'm doing wrong?
Basically, you have a version confusion of same named table between local Access frontend database and backend SQL Server database. Currently, your code updates the tblUserLog on the SQL Server backend side and is not the same tblUserLog on the Access frontend side which likely is the one bound to your form. Hence, why you cannot see any update as the server table is never shown.
Simply do one of two things:
Use SQL Server Version: Delete or archive the Access' version and add tblUserLog as an ODBC linked table. Be sure to remove the dbo_ or other schema prefix and keep same name tblUserLog. And since table names do not change, everything such as forms and VBA code should not need to change.
Use Access Version: Keep the local Access table, tblUserLog, and update this one in VBA which requires adding another connection object and running a recordset update on that connection. See below with prefixes of server_ and local_ on ADO objects:
' OPEN SERVER CONNECTION AND SERVER TABLE RECORDSET
Set server_conn = New ADODB.Connection
With server_conn
.ConnectionString = "Provider=SQLNCLI11;Data Source=(My Server Name);Initial Catalog=(My Database Name);User ID=(Username);Password=(Password)"
.Open
If .State = adStateClosed Then
MsgBox "Connection unsuccessful. Could not open connection.", vbInformation, "Error:"
End If
End With
Set server_rst = New ADODB.Recordset
With server_rst
.ActiveConnection = conn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockOptimistic
.Open "tbl_Users"
End With
' OPEN LOCAL CONNECTION AND UPDATE LOCAL TABLE RECORDSET
Set local_conn = CurrentProject.Connection
Set local_rstLog = New ADODB.Recordset
local_rstLog.Open "tblUserLog", local_conn, adOpenStatic, adLockOptimistic
local_rstLog.AddNew
local_rstLog!UserID = server_rst!UserID ' NOTICE SERVER DATA USED HERE
local_rstLog!TimeIn = DateTime.Now()
local_rstLog.Update
...
' RELEASE RESOURCES
Set server_rst = Nothing: Set local_rstLog = Nothing
Set server_conn = Nothing: Set local_conn = Nothing

Requested operation requires an OLE DB Session object... - Connecting Excel to SQL server via ADO

I'm attempting to take Excel 2003 and connect it to SQL Server 2000 to run a few dynamicly generated SQL Queries which ultimately filling certain cells.
I'm attempting to do this via VBA via ADO (I've tried 2.8 to 2.0) but I'm getting an error while setting the ActiveConnection variable which is inside the ADODB.Connection object. I need to resolve this pretty quick...
Requested operation requires an OLE DB Session object, which is not supported by the current provider.
I'm honestly not sure what this error means and right now I don't care. How can get this connection to succeed so that I can run my queries?
Here is my VB code:
Dim SQL As String, RetValue As String
SQL = " select top 1 DateTimeValue from SrcTable where x='value' " 'Not the real SQL
RetValue = ""
Dim RS As ADODB.Recordset
Dim Con As New ADODB.Connection
Dim Cmd As New ADODB.Command
Con.ConnectionString = "Provider=sqloledb;DRIVER=SQL Server;Data Source=Server\Instance;Initial Catalog=MyDB_DC;User Id=<UserName>;Password=<Password>;"
Con.CommandTimeout = (60 * 30)
Set Cmd.ActiveConnection = Con ''Error occurs here.
' I'm not sure if the rest is right. I've just coded it. Can't get past the line above.
Cmd.CommandText = SQL
Cmd.CommandType = adCmdText
Con.Open
Set RS = Cmd.Execute()
If Not RS.EOF Then
RetValue = RS(0).Value
Debug.Print "RetValue is: " & RetValue
End If
Con.Close
I imagine something is wrong with the connection string but I've tried over a dozen variations. Now I'm just shooting in the dark....
Note/Update: To make matters more confusing, if I Google for the error quote above, I get a lot of hits back but nothing seems relevant or I'm not sure what information is relevant....
I've got the VBA code in "Sheet1" under "Microsoft Excel Objects." I've done this before but usually put things in a module. Could this make a difference?
You have not opened your connection yet. I think you need a Con.Open before you assign it to the Command object.
Con.ConnectionString = "Provider=sqloledb;DRIVER=SQL Server;Data Source=Server\Instance;Initial Catalog=MyDB_DC;User Id=<UserName>;Password=<Password>;"
Con.CommandTimeout = (60 * 30)
Con.Open
Set Cmd.ActiveConnection = Con 'Error occurs here.
Cmd.CommandText = SQL
Cmd.CommandType = adCmdText

Resources