Excel VBA - Run SQL Stored Procedure Error - sql

I have the following code in my Excel workbook that I copied from this page.
Code:
Sub Button1_Click()
Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim WSP1 As Worksheet
Set con = New ADODB.Connection
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset
'''Clear extract area'''
Worksheets("Extract").UsedRange.Delete
'''Log into SQL Server'''
con.Open "Provider = SQLOLEDB;" & _
"Data Source = MySource;" & _
"Initial Catalog = MyDB;" & _
"User ID = MyID;" & _
"Password = MyPassword;"
cmd.ActiveConnection = con
'''Set up parameters for stored procedure'''
cmd.Parameters.Append cmd.CreateParameter("startDate", adDate, adParamInput, , Range("C2"))
cmd.Parameters.Append cmd.CreateParameter("endDate", adDate, adParamInput, , Range("C3"))
cmd.CommandText = "DB.StoredProc"
Set rs = cmd.Execute(, , adCmdStoredProc)
Set WSP1 = Worksheets("Extract")
WSP1.Activate
If rs.EOF = False Then WSP1.Cells(1, 1).CopyFromRecordset rs
rs.Close
Set rs = Nothing
Set cmd = Nothing
con.Close
Set con = Nothing
End Sub
I get the following error message on the line 'If rs.EOF = False Then'
"Operation is not allowed when the object is closed."
This is the first time I've used these functions. What have I done wrong?
Also, have I set up the multiple parameters correctly?
---Quick Edit---
Not sure if it's worth mentioning that I have formatted my date as yyyy-mm-dd, as it is in SQL server.

I've solved the issue by adding SET NOCOUNT ON to my stored procedure.
I wasn't initially sure if I would have access to be able to make that change. I have a new issue though. It works if I only use a single parameter but not when I use multiple parameters.
I will close this thread, do some research and potentially open a new one.
Thanks for your help.

cmd.CommandText = "DB.StoredProc"
should be the actual name of your stored procedure - unless you've actually named it StoredProc?

Here are two options for you to consider.
Option Explicit
Sub RunSProc()
'USE [Northwind]
'GO
'DECLARE #return_value int
'EXEC #return_value = [dbo].[TestNewProc]
' #ShipCountry = NULL
'SELECT 'Return Value' = #return_value
'GO
Dim con As Connection
Dim rst As Recordset
Dim strConn As String
Set con = New Connection
strConn = "Provider=SQLOLEDB;"
strConn = strConn & "Data Source=YOUR_SERVER_NAME;"
strConn = strConn & "Initial Catalog=YOUR_DB_NAME;"
strConn = strConn & "Integrated Security=SSPI;"
con.Open strConn
'Put a country name in Cell E1
Set rst = con.Execute("Exec dbo.TestNewProc '" & ActiveSheet.Range("E1").Text & "'")
'The total count of records is returned to Cell A5
ActiveSheet.Range("A5").CopyFromRecordset rst
rst.Close
con.Close
End Sub
Sub TryThis()
'USE [Northwind]
'GO
'DECLARE #return_value int
'EXEC #return_value = [dbo].[Ten Most Expensive Products]
'SELECT 'Return Value' = #return_value
'GO
Dim con As Connection
Dim rst As Recordset
Set con = New Connection
con.Open "Provider=SQLOLEDB;Data Source=YOUR_SERVER_NAME;Initial Catalog=YOUR_DB_NAME;Integrated Security=SSPI;"
Set rst = con.Execute("Exec dbo.[Ten Most Expensive Products]")
'Results of SProc are returned to Cell A1
ActiveSheet.Range("A1").CopyFromRecordset rst
rst.Close
con.Close
End Sub

Related

SQL Query Returns empty Recordset

I'm trying to learn how to connect to a SQL Server DB from Excel DB. I've tried to reduce the code to dead simple to begin with. I've looked at several answers to related questions, however, I cannot figure out why this doesn't work. It executes all the way through. (The code shown here is somewhat anonymized.)
The query finds the database, because if the table name is invalid it throws an error. However it always returns record count = -1. I can eyeball the table in MSSMS and it has data. Same result for other tables in the DB.
Public Sub ADOtest1()
Dim Conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConnString As String
strConnString = "Provider='SQLOLEDB'" & ";" & _
"Data Source='XXX-XPS\SQLEXPRESS'" & ";" & _
"Initial Catalog='XXXXX'" & ";" & _
"Integrated Security='SSPI'"
Set Conn = New ADODB.Connection
Conn.Open strConnString
' the query finds the DB, because if the table name is incorrect, it throws an error
strSQLString = "SELECT * from t300_XXXX"
Set rs = Conn.Execute(strSQLString)
wrkRecordCount = rs.RecordCount
'--- just some test breakpoints
If wrkRecordCount = -1 Then
a = "" '--- code keeps arriving here
Else
a = ""
End If
rs.Close
Conn.Close
End Sub
Answer from Srinika below worked:
Set rs = Conn.Execute(strSQLString)
rs.Close
rs.CursorLocation = adUseClient
rs.Open
I'll post two examples, so please refer.
First Example
Sub ExampleSQL()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
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"
' Open a connection using an ODBC DSN.
cnn.ConnectionString = "driver={SQL Server};" & _
"server=severname;uid=sa;pwd=password;database=test"
Set rs = New ADODB.Recordset
strSQL = "SELECT * FROM [your Table] "
rs.Open strSQL, cnn.ConnectionString, adOpenForwardOnly, adLockReadOnly, adCmdText
cnn.Open
If cnn.State = adStateOpen Then
Else
MsgBox "Sever is not connected!! "
Exit Sub
End If
If Not rs.EOF Then
With Ws
.Range("a4").CurrentRegion.ClearContents
For i = 0 To rs.Fields.Count - 1
.Cells(4, i + 1).Value = rs.Fields(i).Name
Next
.Range("a5").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
Second Example
Sub getDataFromServer()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim i As Integer
con.ConnectionString = "Provider=SQLOLEDB.1;" _
& "Server=(local);" _
& "Database=TEST;" _
& "Integrated Security=SSPI;" _
& "DataTypeCompatibility=80;"
con.Open
Set cmd.ActiveConnection = con
cmd.CommandText = "SELECT * FROM [your Table]"
Set rs = cmd.Execute
Range("A1").CopyFromRecordset rs
con.Close
Set con = Nothing
End Sub

Using VBA to query a VIEW from SQL Server

I am trying to create a VBA script that will pull the results from a View (SELECT * FROM view_name) from the RecordSet.Source property, but when attempted, my CloseConnection error handler keeps getting caught. I can get results from a table using a simple query like SELECT * FROM tbl_name with no issues.
Below is the code I am using. Note: my Const variable has the Provider and Database information removed.
I guess it really comes down to is it even possible to get results from a View like I would from a table?
Option Explicit
Const ConStrMSSQL As String = _
"Provider=provider_name;Database=database_name;Trusted_Connection=yes;"
Sub test()
Dim formConnect As ADODB.connection
Dim formData As ADODB.recordSet
Dim formField As ADODB.Field
Set formConnect = New ADODB.connection
Set formData = New ADODB.recordSet
formConnect.ConnectionString = ConStrMSSQL
formConnect.Open
On Error GoTo CloseConnection
With formData
.ActiveConnection = formConnect
.Source = "SELECT * FROM v_data_extract_658"
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
On Error GoTo CloseRecordset
Sheets("test").Range("A1").Select
For Each formField In formData.Fields
ActiveCell.Value = formField.Name
ActiveCell.Offset(0, 1).Select
Next formField
Sheets("test").Range("A2").CopyFromRecordset formData
On Error GoTo 0
CloseRecordset:
formData.Close
CloseConnection:
formConnect.Close
End Sub
This is the error message:
run-time error 2147467259 (80004005): unknown token received from SQL Server
I think the big issue here is that you haven't defined a Command Object.
I somewhat put this together "freehand" and for certain, didn't test it but it should get you to where you need to go.
Sub test()
On Error GoTo ErrorHandle:
Dim formConnect As ADODB.Connection
Set formConnect = New ADODB.Connection
formConnect.ConnectionString = ConStrMSSQL
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
formConnect.Open
With cmd
.ActiveConnection = formConnect
.CommandType = adCmdText
.CommandText = "SELECT * FROM v_data_extract_658"
.CommandTimeout = 30
End With
Dim formData As ADODB.Recordset
Set formData = New ADODB.Recordset
formData.Open cmd, , adOpenStatic, adLockReadOnly
Sheets("test").Range("A1").Select
Dim formField As ADODB.Field
For Each formField In formData.Fields
ActiveCell.value = formField.Name
ActiveCell.Offset(0, 1).Select
Next formField
Range("A2").CopyFromRecordset formData
On Error GoTo 0
Cleanup:
If Not formData Is Nothing Then
If formData.State <> adStateClosed Then formData.Close
Set formData = Nothing
End If
If Not formConnect Is Nothing Then
If formConnect.State <> adStateClosed Then formConnect.Close
Set formConnect = Nothing
End If
Set cmd = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description
'Do whatever else is needed to respond to errors.
Resume Cleanup
End Sub
Using Excel & VBA to fetch dta from SLQ Server is quite easy (not always, but these days).
Sub ADOExcelSQLServer()
' Carl SQL Server Connection
'
' FOR THIS CODE TO WORK
' In VBE you need to go Tools References and check Microsoft Active X Data Objects 2.x library
'
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "EXCEL-PC\SQLEXPRESS" ' Enter your server name here
Database_Name = "NORTHWND" ' Enter your database name here
User_ID = "" ' enter your user ID here
Password = "" ' Enter your password here
SQLStr = "SELECT * FROM [Customers]" ' Enter your SQL here
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
' Dump to spreadsheet
For iCols = 0 To rs.Fields.Count - 1
Worksheets("Sheet1").Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
With Worksheets("sheet1").Range("a2:z500") ' Enter your sheet name and range here
'.ClearContents
.CopyFromRecordset rs
End With
' Tidy up
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
As an aside, you can try this as well (please change to suit your specific setup/configuration)...
Sub Working2()
Dim con As Connection
Dim rst As Recordset
Dim strConn As String
Set con = New Connection
strConn = "EXCEL-PC\SQLEXPRESS;Database=Northwind;Trusted_Connection=True"
con.Open strConn
'Put a country name in Cell E1
Set rst = con.Execute("Exec dbo.MyOrders '" & ActiveSheet.Range("E1").Text & "'" & ActiveSheet.Range("E2").Text & "'")
'The total count of records is returned to Cell A5
ActiveSheet.Range("A5").CopyFromRecordset rst
rst.Close
con.Close
End Sub
Please see the link below for more details.
https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm#Excel%20Data%20Export%20to%20SQL%20Server%20Test%20Code

If InputBox equals Value1 then connect to Database1

I'm trying to create a VBA code that would connect to a specific database based on the user's input. E.g. if a user enters DB1 into the prompt, the code will run the following query: SELECT * FROM MyServerName.DB1.dbo.Table
Here is what I've got so far:
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim strSQL As String
Dim DB As Variant
DB = InputBox("Please enter the Database Name.")
sConnString = "Provider=SQLOLEDB;Data Source=MyServerName;" & _
"Integrated Security=SSPI;"
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Unsuccessful attempt to use the Else/If statement:
if '" & DB & "' = "DB1" then
conn.Open sConnString
Set rs = conn.Execute("SELECT * FROM MyServerName.DB1.dbo.Table ;")
elseif '" & DB & "' = "DB2" then
conn.Open sConnString
Set rs = conn.Execute("SELECT * FROM MyServerName.DB2.dbo.Table ;")
else
MsgBox "No records returned. Enter the correct Database Name.", vbCritical
End If
If Not rs.EOF Then
Sheets("Sheet1").Range("A2").CopyFromRecordset rs
rs.Close
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
The connection itself is working just fine when I use the select statement without Else/If. Does anyone know how to fix this? Thanks so much!
You could just use the DB variable to decide which database to use
Set rs = conn.Execute("SELECT * FROM [MyServerName].[" & DB & "].dbo.table ;")

VBA: How to capture a stored procedure return value

My goal is to execute a sql server stored procedure from a vba function, and to check if the stored procedure returned any records.
In the vba code I gotten this far:
Function TestStoredProcedure()
Dim strMsg As String
Dim ADOCon As ADODB.Connection
Dim ADOQD As ADODB.Command
Dim ADORS As ADODB.Recordset
Set ADOCon = New ADODB.Connection
ADOCon.ConnectionString = GetConnectionString("Dev")
ADOCon.CommandTimeout = 0
ADOCon.Open
Set ADOQD = New ADODB.Command
ADOQD.ActiveConnection = ADOCon
ADOQD.CommandTimeout = 0
ADOQD.CommandType = adCmdStoredProc
ADOQD.CommandText = "mn_CheckForInvalidEntries"
'Execute
Set ADORS = ADOQD.Execute
If ADORS.RecordCount > 0 Then
strMsg = "The SLI Search Feed was not successful."
MsgBox strMsg, vbExclamation, "foo"
Else
strMsg = "The SLI Search Feed successful."
MsgBox strMsg, vbExclamation, "foo"
End If
ADOCon.Close
Set ADOQD = Nothing
Set ADOCon = Nothing
strMsg = ""
End Function
And the stored procedure:
ALTER PROCEDURE [dbo].[mn_CheckForInvalidEntries]
AS
BEGIN
SET NOCOUNT ON;
SELECT
[ProductID]
, [ForSale]
FROM [Product]
WHERE [ProductID] IN
(
SELECT
[SearchIndex].[ProductID]
FROM [dbo].[SearchIndex]
INNER JOIN [ProductData]
ON [dbo].[SearchIndex].[ProductID] = [ProductData].[ProductID]
WHERE [ForSale] = 1
AND [SearchIndex].[ProductID] NOT LIKE 'mn[d-g]%'
AND [Record] IS NULL
AND [SearchIndex].[ProductID] NOT LIKE 'mn[a-z]%'
END;
If I could get any help in getting the part of the check if the sp returned any values, that would be great.
Thank you.
To store the results you can use a recordset.
Dim adoRs As ADODB.Recordset
Set adoRs = ADOQD.Execute
Then you can ask whether the recordset is empty.
isEmpty = (adoRs.BOF And adoRs.EOF)
All you want to do is run a stored procedure from Excel, right? Here are two options for you to try.
Option Explicit
Sub Working2()
Dim con As Connection
Dim rst As Recordset
Dim strConn As String
Set con = New Connection
strConn = "Provider=SQLOLEDB;"
strConn = strConn & "Data Source=LAPTOP\SQL_EXPRESS;"
strConn = strConn & "Initial Catalog=Northwind;"
strConn = strConn & "Integrated Security=SSPI;"
con.Open strConn
'Put a country name in Cell E1
Set rst = con.Execute("Exec dbo.TestNewProc '" & ActiveSheet.Range("E1").Text & "'")
'The total count of records is returned to Cell A5
ActiveSheet.Range("A5").CopyFromRecordset rst
rst.Close
con.Close
End Sub
Sub Working()
Dim con As Connection
Dim rst As Recordset
Set con = New Connection
con.Open "Provider=SQLOLEDB;Data Source=LAPTOP\SQL_EXPRESS;Initial Catalog=Northwind;Integrated Security=SSPI;"
Set rst = con.Execute("Exec dbo.[Ten Most Expensive Products]")
'Results of SProc are returned to Cell A1
ActiveSheet.Range("A1").CopyFromRecordset rst
rst.Close
con.Close
End Sub

Insert Data to Excel from SQL Table using a Stored Procedure

I would like to insert data from a SQL Table to an Excel sheet everyday using a stored procedure. It has to delete the data in excel and insert the new data to same sheet.
How do I do this?
I get an error in this code
Sub Connecion()
' Create a connection object.
Dim cnPubs As ADODB.Connection
Set cnPubs = New ADODB.Connection
' Provide the connection string.
Dim strConn As String
'Use the SQL Server OLE DB Provider.
strConn = "PROVIDER=SQLOLEDB;"
'Connect to the Pubs database on the local server.
strConn = strConn & "DATA SOURCE=(10.200.157.110);INITIAL CATALOG=Brickstream_DEVMGR;"
'Use an integrated login.
strConn = strConn & " INTEGRATED SECURITY=sspi;"
'Now open the connection.
cnPubs.Open strConn
End Sub
Below code worked for me
Sub GetDataFromADO()
'Declare variables'
Set objMyConn = New ADODB.Connection
Set objMyRecordset = New ADODB.Recordset
Dim strSQL As String
'Open Connection'
objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source=10.200.157.110;Initial Catalog=Brickstream_DEVMGR;User ID=usr_bayi;Password=3Ay1usr;"
objMyConn.Open
'Set and Excecute SQL Command'
strSQL = "select * from DEALER_DETAILED"
'Open Recordset'
Set objMyRecordset.ActiveConnection = objMyConn
objMyRecordset.Open strSQL
'Copy Data to Excel'
ActiveSheet.Range("A2").CopyFromRecordset (objMyRecordset)
End Sub
Easy ask.
Sub ADOExcelSQLServer()
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "your_server_name" ' Enter your server name here
Database_Name = "Northwind" ' Enter your database name here
User_ID = "" ' enter your user ID here
Password = "" ' Enter your password here
SQLStr = "SELECT * FROM Orders" ' Enter your SQL here
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
With Worksheets("Sheet1").Range("A2:Z500")
.ClearContents
.CopyFromRecordset rs
End With
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub