I am trying to run a SP inside a function in an excel macro (button):
Sub Button13_Click()
Call exec_sp_GetLoan_CFM_Info_by_customerID("B3", 2, 1)
Call exec_sp_GetLoan_CFM_Info_by_customerID("B24", 3, 1)
Call exec_sp_GetLoan_CFM_Info_by_customerID("B45", 4, 1)
Call exec_sp_GetLoan_CFM_Info_by_customerID("B66", 5, 1)
Call exec_sp_GetLoan_CFM_Info_by_customerID("B86", 6, 1)
End Sub
The SP returns a single row every time, and I'm trying to write a row with every result set. What happens is that I'm getting a single row in the spreadsheet, for example, as it is shown above, I would only get row 2 with result set for custID from B3. If I comment out the first line, I would only get row 3 with results for custID from B24, and so on. I can never get more than 1 row, and I don't understand why (I'm completely new to vb and excel macros). Can anybody explain what's happening? This is happening even if I don't clear any rows... thank you!
Update: If I set up separate buttons for each 'Call' of the function, it runs fine...
Function exec_sp_GetLoan_CFM_Info_by_customerID(custIDcell As String, stRow As Integer, stCol As Integer)
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
Application.DisplayStatusBar = True
Application.StatusBar = "Contacting SQL Server..."
' Log in
con.Open "Provider=SQLOLEDB;Data Source=xxxx;Initial Catalog=xxxx ID=xxxx;Password=xxxx;"
cmd.ActiveConnection = con
' Set up the parameter for the Stored Procedure
cmd.Parameters.Append cmd.CreateParameter("custID", adVarChar, adParamInput, 8, Range(custIDcell).Text)
Application.StatusBar = "Running stored procedure..."
cmd.CommandText = "sp_GetLoan_CFM_Info_by_customerID"
Set rs = cmd.Execute(, , adCmdStoredProc)
Set WSP1 = ActiveWorkbook.Worksheets("CIFInfo")
WSP1.Activate
'clear row
WSP1.Rows(stRow).Clear
If rs.EOF = False Then WSP1.Cells(stRow, stCol).CopyFromRecordset rs
'cmd.Parameters("custID").Value = Range("B24").Text
'cleanup
rs.Close
Set rs = Nothing
Set cmd = Nothing
con.Close
Set con = Nothing
Application.StatusBar = "Data successfully updated."
End Function
Beginner's (Excel) mistake... after calling the function with the SP for the first time, the active worksheet gets changed to a different one from the input, so subsequent calls are done with an empty input parameter!!
That wasn't obvious from the post.. sorry!!
Related
I have a stored procedure call which is duplicating rows through Excel, I think it has to do with the method I am using for the copy from record set. The data when the query is run manually outputs the correct data.
Private Sub Refresh_Click()
Dim Conn As ADODB.Connection, RecordSet As ADODB.RecordSet
Dim Command As ADODB.Command
Dim ConnectionString As String, StoredProcName As String
Dim StartDate As ADODB.Parameter, EndDate As ADODB.Parameter
Application.ScreenUpdating = False
Set Conn = New ADODB.Connection
Set RecordSet = New ADODB.RecordSet
Set Command = New ADODB.Command
' I blanked out the details here as they are not required as this is working
ConnectionString = "PROVIDER=SQLOLEDB;DATA SOURCE=xxxx;INITIAL CATALOG=xxxx; User Id=xxxx;Password=xxxx;"
On Error GoTo CloseConnection
Conn.Open ConnectionString
SellStartDate = Format(Sheets("Sheet1").Range("B2").Value2, "yyyy-mm-dd")
SellEndDate = Format(Sheets("Sheet1").Range("B3").Value2, "yyyy-mm-dd")
StoredProcName = "fsp_PLReportByDates"
With Command
.ActiveConnection = Conn
.CommandType = adCmdStoredProc
.CommandText = StoredProcName
End With
Set StartDate = Command.CreateParameter("#DateFrom", adDBDate, adParamInput, , SellStartDate)
Set EndDate = Command.CreateParameter("#DateTo", adDBDate, adParamInput, , SellEndDate)
Command.Parameters.Append StartDate
Command.Parameters.Append EndDate
Set RecordSet = Command.Execute
Sheets("Sheet1").Range("A7").CopyFromRecordset RecordSet
For intColIndex = 0 To RecordSet.Fields.Count - 1
Range("A6").Offset(0, intColIndex).Value = RecordSet.Fields(intColIndex).Name
Next
RecordSet.Close
Conn.Close
On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub
CloseConnection:
Application.ScreenUpdating = True
MsgBox "SQL Stored Procedure Did Not Execute Sucessfully!", vbCritical, "SQL Error"
Conn.Close
End Sub
Assuming that your old recordset/previous pull is bigger than your new one and when you drop the new one over the old one, some of the old records are still present in your sheet...
Make a named range that grows dynamically with your data. Assuming you have 10 columns from your Proc coming back and any number of rows, make a named range called rng_PLReportByDates and set it to:
=OFFSET(Sheet1!$A$7, 0, 0, COUNTA(Sheet1!$A$7:$A$5000)+1, 10)
This will create a named range that has 10 columns and up to 4993 rows. I assume that's plenty for your recordset, otherwise bump that 5000 to whatever makes sense. The +1 is there just to insure that if the range is completely empty (no values) that this formula will return at least 1 row, otherwise you will error out.
Then... Just before you run:
Sheets("Sheet1").Range("A7").CopyFromRecordset RecordSet
Add this:
Range("rng_PLReportByDates").ClearContents
You can also change that CopyFromRecordset to use your new dynamically sized named range:
Range("rng_PLReportByDates").CopyFromRecordset Recordset
I use this method every time I dump a recordset to a worksheet. I create a dynamically sized named range using that same formula, and then I .ClearContents and .CopyFromRecordset to it.
If your number of columns changes, then you can just add a Counta() formula to that last parameter in the named range formula:
=OFFSET(Sheet1!$A$7, 0, 0, COUNTA(Sheet1!$A$7:$A$5000)+1, COUNTA(Sheet1!$A$7:$IV$7)+1)
As far as the header is concerned, you may want to adjust the named range to go after row 6. Then you can do:
Range("rng_PLReportByDates").ClearContents
Range("rng_PLReportByDates").Offset(1).CopyFromRecordset Recordset
And then do your range work just the same.
Using MS Access to complete this project.
I am attempting to simplify my ADODB code by removing the need for the ADODB.Command object. There are two requirements, the need to use parameters and the need to retrieve records affected (for verification that the SQL executed properly).
The syntax I am attempting to use was mentioned in an article documented in the code block.
{connection object}.[{name of query}] {parameter 1, ..., parameter n [, record set object]}
cn.[TEST_ADODB_Connection] 204, Date & " " & Time(), rs
Sub TEST_ADODB_Connection()
'https://technet.microsoft.com/en-us/library/aa496035(v=sql.80).aspx
'Using ADODB without the use of .Command
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim lngRecordsAffected As Long
Set cn = CurrentProject.Connection
'TEST_ADODB_Connection Query
'INSERT INTO tbl_Log ( LogID_Orig, LogMessage )
'SELECT [NewLogID] AS _LogID, [NewLogMessage] AS _LogMessage;
Set rs = New ADODB.Recordset
cn.[TEST_ADODB_Connection] 204, Date & " " & Time(), rs
lngRecordsAffected = rs.RecordCount 'Error 3704 - no records returned
'so this is expected, but how do we
'get records affected by the update query?
Debug.Print lngRecordsAffected
End Sub
UPDATE
Including the original code attempting to be simplified.
The .Command object does provide the functionality I desire, but I am looking for an alternative method if it is feasible.
The article (https://technet.microsoft.com/en-us/library/aa496035(v=sql.80).aspx) provides an example where the .Connection object could be executed using parameters. I am trying to extend that example and obtain records affected.
Sub TEST_ADODB_Command()
Dim cm As ADODB.Command
Dim rs As ADODB.Recordset
Dim iLogID_Auto As Integer
Dim strLogMessage As String
Dim lngRecordsAffected As Long
Set cm = New ADODB.Command
iLogID_Auto = 204
strLogMessage = Date & " " & Time
With cm
Set .ActiveConnection = CurrentProject.Connection
.CommandText = "TEST_ADODB_Connection"
.CommandType = adCmdStoredProc
.NamedParameters = True ' does not work in access
.Parameters.Append .CreateParameter("[NewLogID]", adInteger, adParamInput, , iLogID_Auto)
.Parameters.Append .CreateParameter("[NewLogMessage]", adVarChar, adParamInput, 2147483647, strLogMessage)
Set rs = .Execute(lngRecordsAffected)
Debug.Print lngRecordsAffected
End With
Set rs = Nothing
Set cm = Nothing
End Sub
Thank you for the comments. I believe I have devised what I was searching for.
Two points
ADODB.Command is needed if you want to insert/update and retrieve a record count using parameters using a single .Execute. Examples of this can be found all over the internet including my original post under the update section.
ADODB.Command is NOT needed if you have an insert/update query and a select query. I could not find examples of this method. Below is an example I have come up with.
High level overview of what is going on
Execute the insert/update query. Inserts/Updates will not return a recordSet using the one line method.
Execute a select query. This will return a recordSet, however, I couldn't get the .Count method to work as I would think it should.
tlemaster's suggested link provided a work around in the answer section. The work around is to revise the select query to group the results and use the COUNT(*) to return the count. The returning value is then utilized instead of the .Count method.
Sub TEST_ADODB_Connection()
'https://technet.microsoft.com/en-us/library/aa496035(v=sql.80).aspx
'Using ADODB without the use of .Command and .Parameters
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim lngRecordsAffected As Long
Dim strDateTime As String
Dim lngID As Long
Set cn = CurrentProject.Connection
strDateTime = Date & " " & Time()
lngID = 204 'random number for example purpose
'TEST_ADODB_Connection INSERT Query
'INSERT INTO tbl_Log ( LogID_Orig, LogMessage )
'SELECT [NewLogID] AS _NewLogID, [NewLogMessage] AS _LogMessage;
'This line will execute the query with the given parameters
'NOTE: Be sure to have the parameters in the correct order
cn.[TEST_ADODB_Connection] lngID, strDateTime
'TEST_ADODB_Select
'SELECT Count(tbl_Log.LogID_Orig) AS recordCount
'FROM tbl_Log
'WHERE tbl_Log.LogID_Orig=[_LogID] AND tbl_Log.LogMessage=[_LogMessage];
'Must initilize recordset object
Set rs = New ADODB.Recordset
'This line will execute the query with given parameters and store
'the returning records into the recordset object (rs)
'NOTE: Again, be sure the parameters are in the correct order
'NOTE: the recordset object is always the last argument
cn.[TEST_ADODB_Select] lngID, strDateTime, rs
'unable to directly utilize the .Count method of recordset
'workaround and more optimal solution is to write the SQL
'to return a count using grouping and Count(*) - see SQL above
lngRecordsAffected = rs("recordCount").Value
'Close recordset object
rs.Close
Debug.Print lngRecordsAffected
End Sub
I just startied working with this database and I have a small problem.
So the main idea behind this is to use VBA to get needed information from database that I can use later on.
I am using ADO recordset and connect sting to connect to server. All is fine apart from one problem: when I am creating RecordSet by using SQL request it only returns one field when i know there should me more. At the moment I think that RecordSet is just grabbing first result and storing it in but looses anything else that should be there. Can you please help me.
Here is my code:
'Declare variables'
Dim objMyConn As ADODB.Connection
Dim objMyCmd As ADODB.Command
Dim objMyRecordset As ADODB.Recordset
Dim fldEach As ADODB.Field
Dim OrderNumber As Long
OrderNumber = 172783
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
'Open Connection'
objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source=Local;" & _
"Initial Catalog=SQL_LIVE;"
objMyConn.Open
'Set and Excecute SQL Command'
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = "SELECT fldImage FROM tblCustomisations WHERE fldOrderID=" & OrderNumber
objMyCmd.CommandType = adCmdText
'Open Recordset'
Set objMyRecordset.Source = objMyCmd
objMyRecordset.Open
objMyRecordset.MoveFirst
For Each fldEach In objMyRecordset.Fields
Debug.Print fldEach.Value
Next
At the moment Debug returns only one result when it should return two because there are two rows with the same OrderID.
The recordset only opens a single record at a time. You are iterating through all the fields in a single record. Not each record in the recordset.
If your query returns two records, you need to tell the Recordset to advance to the next one.
A query returns one recordset which has some number of records which have some number of fields.
You are iterating through the fields only for one record in the returned recordset.
You can do this with a few ways, but I generally do something like:
objMyRecordset.MoveFirst
Do
If Not objMyRecordset.EOF Then
debug.print "Record Opened - only returning 1 field due to SQL query"
For Each fldEach In objMyRecordset.Fields
Debug.Print fldEach.Value
Next
'this moves to the NEXT record in the recordset
objMyRecordset.MoveNext
Else
Exit Do
End If
Loop
Note that if you want to include more fields you will need to modify this line:
objMyCmd.CommandText = "SELECT fldImage FROM tblCustomisations WHERE fldOrderID=" & OrderNumber
To include whatever additional fields you want returned.
In addition to the #enderland's answer, you can also have a disconnected RecordSet, that have all the values and fields ready for consumption. It's handy when you need to pass the data around or need to close the connection fast.
Here's a function that returns a disconnected RecordSet:
Function RunSQLReturnRS(sqlstmt, params())
On Error Resume next
' Create the ADO objects
Dim rs , cmd
Set rs = server.createobject("ADODB.Recordset")
Set cmd = server.createobject("ADODB.Command")
' Init the ADO objects & the stored proc parameters
cmd.ActiveConnection = GetConnectionString()
cmd.CommandText = sqlstmt
cmd.CommandType = adCmdText
cmd.CommandTimeout = 900 ' 15 minutos
collectParams cmd, params
' Execute the query for readonly
rs.CursorLocation = adUseClient
rs.Open cmd, , adOpenForwardOnly, adLockReadOnly
If err.number > 0 then
BuildErrorMessage()
exit function
end if
' Disconnect the recordset
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Set rs.ActiveConnection = Nothing
' Return the resultant recordset
Set RunSQLReturnRS = rs
End Function
You are mixing up terms in your question which makes it unclear
In your first paragraph you describe a problem with "Fields", in the last paragraph you turn it into "Rows". Not exactly the same.
But whatever you are trying to achieve, the code you wrote will only return one field and one row.
If you want all FIELDS, your query should be:
objMyCmd.CommandText = "SELECT * FROM tblCustomisations WHERE fldOrderID=" & OrderNumber
If you want all ROWS, your loop should be:
objMyRecordset.MoveFirst
If Not objMyRecordset.BOF Then
While Not objMyRecordset.EOF
debug.print objMyRecordset!fldImage
RS.MoveNext
Wend
End If
Hi I'm trying to program a file to get data from SQL to an array in VBA.
First I tried to use this code and worked with my computer, but after testing the file in other users computer I found the error type-2146825287 when the macro got to the place where it opens the connection. I'm not part of IT department so I will not be able to update the users Service Packs so I tried to reuse another code made by other user that worked for another file some years ago.
This was my first aproach:
Function ConsultaQueryADODB(ConexionString, Query) As Variant
Dim CnADODB As ADODB.Connection
Set CnADODB = New ADODB.Connection
CnADODB.ConnectionString = ConexionString
CnADODB.Open
Dim RsADODB As ADODB.Recordset
Set RsADODB = New ADODB.Recordset
/// Open RecordSet
Set RsADODB = CnADODB.Execute(Query)
///Keep the Recordset using an Array
Dim ArrayQuery As Variant
ArrayQuery = RsADODB.GetRows
RsADODB.Close
Set RsADODB = Nothing
ConsultaQueryADODB = ArrayQuery
End Function
In the old file I found, the programmer was able to connect to the DB and it worked in other users computers. This was his code:
Public Sub QueryBrand()
Dim cn As Object
Set cn = CreateObject("ADODB.Connection")
cn.ConnectionString = "driver={SQL Server};server=SERVERNAME;database=BDInfo;uid=Hello;pwd=Hi"
Dim rst As Object
cn.Open
Set rst = CreateObject("ADODB.Recordset")
Sql = "SELECT distinct Brand FROM BlablaTable order by Brand"
rst.Open Sql, cn, 1, 3
c = 0
f = 2
Sheets("Sheet1").Activate
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Do While Not rst.EOF
Hoja2.Cells(f, 2) = rst.Fields("Marca")
f = f + 1
rst.MoveNext
Loop
On Error Resume Next
rst.Close
cn.Close
Set cn = Nothing
Set rst = Nothing
End Sub
I tried to modify this code to use it like my first aproach to save the recorset to an array. Now I'm able to open the connection and to open the recordset, but I'm not able to use the GetRows Method cause it becomes an Error 3021. Again in my computer it runs well, but when I run it in another computer it doesnt.
This is my second aproach:
Function ConsultaQueryADODB(ConexionString, Query) As Variant
Set CnADODB = CreateObject("ADODB.Connection")
CnADODB.ConnectionString = ConexionString
Dim RsADODB As Object
CnADODB.Open
Set RsADODB = CreateObject("ADODB.Recordset")
'/// Open the RecordSet
RsADODB.Open Query, CnADODB
'///Save the recordset into an array
Dim ArrayQuery As Variant
ArrayQuery = RsADODB.GetRows '----HERE APPEARS AN ERROR 3021 in the others computers
RsADODB.Close
Set RsADODB = Nothing
ConsultaQueryADODB = ArrayQuery
CnADODB.Close
Set CnADODB = Nothing
End Function
Is there any alternative to populate an array without using the GetRows Method? Do you have some alternatives for this code o connection?
Thanks in advance for your help!
Try the following code below. If not records are returned, the array will be empty which you'll need to check.
Function ConsultaQueryADODB(ConexionString, Query) As Variant()
Set CnADODB = CreateObject("ADODB.Connection")
CnADODB.ConnectionString = ConexionString
Dim RsADODB As Object
CnADODB.Open
Set RsADODB = CreateObject("ADODB.Recordset")
'/// Open the RecordSet
RsADODB.Open Query, CnADODB
'///Save the recordset into an array
If Not RsADODB.BOF And Not RsADODB.EOF Then
ConsultaQueryADODB = RsADODB.GetRows()
End If
RsADODB.Close
Set RsADODB = Nothing
CnADODB.Close
Set CnADODB = Nothing
End Function
I have a SQL Server 2008 stored procedure that updates values in a table. I would like to have the stored procedure return an integer value indicating that the update was successful (return 0) or not (returns error number). What would be the best way to accomplish this via ADO and VBA? Here some of my code in simplified form that performs the update ... I am just not sure how to get back the return value of the stored procedure
Public Function DoUpdate(employeeID as integer, firstName as string, lastname as string) as integer
Dim cnn As ADODB.Connection
Dim cmd As ADODB.Command
Dim activeConnectionString As String
activeConnectionString = GetActiveConnectionString()
Set cnn = New ADODB.Connection
cnn.ConnectionString = activeConnectionString
cnn.CursorLocation = adUseClient
cnn.Open
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "uspUpdateEmployeeName"
cmd.NamedParameters = True
cmd.Parameters("#EmployeeID").Value = employeeID
cmd.Parameters("#FirstName").Value = firstName
cmd.Parameters("#LastName").Value = lastName
cmd.Execute
'Unsure of how to get back return value here
'DoUpdate = returnValue
Set cnn = Nothing
End Function
Note: The return_value must be the first parameter!
Order matters.
I was getting errors stating that my query "had too many arguments" when I had specified my return_value parameter last, instead of first.
The parameters' ordering was the cause of my error.
If you use
Dim lngRecs As Long
cmd.Execute lngRecs
lngRecs should contain records affected.
I seem to remember that you need to supply an extra parameter with the type 'adParamReturnValue' like this:
Dim lRetVal as Long
Set cmd = New ADODB.Command
cmd.Parameters.Append .CreateParameter("returnvalue", adInteger, adParamReturnValue)
cmd.Execute
'Now check the return value of the procedure
lRetVal = cmd.Parameters("returnvalue")
If lRetVal > 0 then
Several ways are possible to get values back using VBA:
Recordset
Count of records affected (only for Insert/Update/Delete otherwise -1)
Output parameter
Return value
My code demonstrates all four. Here is a stored procedure that returns a value:
Create PROCEDURE CheckExpedite
#InputX varchar(10),
#InputY int,
#HasExpedite int out
AS
BEGIN
Select #HasExpedite = 9 from <Table>
where Column2 = #InputX and Column3 = #InputY
If #HasExpedite = 9
Return 2
Else
Return 3
End
Here is the sub I use in Excel VBA. You'll need reference to Microsoft ActiveX Data Objects 2.8 Library.
Sub CheckValue()
Dim InputX As String: InputX = "6000"
Dim InputY As Integer: InputY = 2014
'open connnection
Dim ACon As New Connection
'ACon.Open ("Provider=SQLOLEDB;Data Source=<SqlServer>;" & _
' "Initial Catalog=<Table>;Integrated Security=SSPI")
'set command
Dim ACmd As New Command
Set ACmd.ActiveConnection = ACon
ACmd.CommandText = "CheckExpedite"
ACmd.CommandType = adCmdStoredProc
'Return value must be first parameter else you'll get error from too many parameters
'Procedure or function "Name" has too many arguments specified.
ACmd.Parameters.Append ACmd.CreateParameter("ReturnValue", adInteger, adParamReturnValue)
ACmd.Parameters.Append ACmd.CreateParameter("InputX", adVarChar, adParamInput, 10, InputX)
ACmd.Parameters.Append ACmd.CreateParameter("InputY", adInteger, adParamInput, 6, InputY)
ACmd.Parameters.Append ACmd.CreateParameter("HasExpedite", adInteger, adParamOutput)
Dim RS As Recordset
Dim RecordsAffected As Long
'execute query that returns value
Call ACmd.Execute(RecordsAffected:=RecordsAffected, Options:=adExecuteNoRecords)
'execute query that returns recordset
'Set RS = ACmd.Execute(RecordsAffected:=RecordsAffected)
'get records affected, return value and output parameter
Debug.Print "Records affected: " & RecordsAffected
Debug.Print "Return value: " & ACmd.Parameters("ReturnValue")
Debug.Print "Output param: " & ACmd.Parameters("HasExpedite")
'use record set here
'...
'close
If Not RS Is Nothing Then RS.Close
ACon.Close
End Sub