Excel VBA passing wrong number of parameters to ADO command object - sql-server

I am trying to debug Excel VBA code that is calling a stored procedure resident on our SQL Server (SQL Server 2008 R2). With a bit of error trapping I can now see what the error is but I have no idea what is causing it.
Here is my VBA code:
Sub Add_Results_Of_ADO_Recordset()
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
Dim stSQL As String
Const stADO As String = "Provider=SQLOLEDB.1;User ID =xxxxx;Password=xxxxx;" & _
"Persist Security Info=False;" & _
"Initial Catalog=MyDatabase;" & _
"Data Source=xxxxxxxxxxxx"
' initialise ADO
Set cnt = New ADODB.Connection
cnt.Open stADO
On Error GoTo Err_SaveProposal
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = cnt
.CommandText = "PolicyList"
.CommandType = adCmdStoredProc
.NamedParameters = True
.Parameters.Refresh
.Parameters.Append .CreateParameter("#Incept", adVarChar, adParamInput, 10, "2/1/2014")
.Parameters.Append .CreateParameter("#Expire", adVarChar, adParamInput, 10, "2/1/2014")
.Parameters.Append .CreateParameter("#PStatus", adVarChar, adParamInput, 20, "BOOK")
End With
' Debug code to ensure parameters are set correctly
For Each prm In cmd.Parameters
Debug.Print prm.Name & " : " & prm.Value
Next
cmd.Execute
If cnt.State = adStateOpen Then cnt.Close
Exit Sub
Err_SaveProposal:
Debug.Print Err.Number & ": " & Err.Description
If cnt.State = adStateOpen Then cnt.Close
End Sub
Here are the messages written to the immediate window:
#RETURN_VALUE :
#Incept :
#Expire :
#PStatus :
#Incept : 2/1/2014
#Expire : 2/1/2014
#PStatus : BOOK
-2147217900: Procedure or function PolicyList has too many arguments specified.
It looks like the three arguments I am trying to send to the stored procedure are being sent twice. Once as empty strings and one with the values I want to send. Any suggestions?

Related

Data not uploading to MS SQL database.

I'm trying to push a button in an excel worksheet and it should send the data from the a worksheet to the sql table. But this vba code is not uploading the data from excel to the database. I have similar other table and it works fine. Any suggestions or thoughts on this would be great.
Sub Send2SQL()
Dim cmd As New ADODB.Command
Dim rst As ADODB.Recordset
Dim UploadTime, SubmissionNumber, WorkbookSection, DataDescription1, DataDescription2, DataDescription3
Dim iValue, sValue, fValue, bValue, dValue, Omit
Dim UploadRow As Integer
Dim LastRow As Integer
'Establish Error Handler
On Error GoTo ErrorHandler
'Determine UploadTime
UploadTime = Format(Now, "mm\/dd\/yyyy hh\:mm\:ss")
'Loop Through Upload
For UploadRow = 2 To LastRow
With Sheets("DataCapture")
WorkbookSection = .Cells(UploadRow, WorkbookSectionColumn).Value
DataDescription1 = .Cells(UploadRow, DataDescription1Column).Value
DataDescription2 = .Cells(UploadRow, DataDescription2Column).Value
DataDescription3 = .Cells(UploadRow, DataDescription3Column).Value
iValue = .Cells(UploadRow, iValueColumn).Value
sValue = Left(.Cells(UploadRow, sValueColumn).Value, 400)
If sValue = "" Then sValue = Empty
fValue = .Cells(UploadRow, fValueColumn).Value
bValue = .Cells(UploadRow, bValueColumn).Value
dValue = .Cells(UploadRow, dValueColumn).Value
End With
With cmd
.ActiveConnection = conn
.CommandType = adCmdStoredProc
.CommandText = "[DataUpload]"
.Parameters.Append .CreateParameter("#TimeOfUpload", adDBTimeStamp, adParamInput, , UploadTime)
.Parameters.Append .CreateParameter("#WorkbookSection", adVarChar, adParamInput, 60, WorkbookSection)
.Parameters.Append .CreateParameter("#DataDescription1", adVarChar, adParamInput, 255, DataDescription1)
.Parameters.Append .CreateParameter("#DataDescription2", adVarChar, adParamInput, 60, DataDescription2)
.Parameters.Append .CreateParameter("#DataDescription3", adVarChar, adParamInput, 60, DataDescription3)
.Parameters.Append .CreateParameter("#iValue", adBigInt, adParamInput, , iValue)
.Parameters.Append .CreateParameter("#sValue", adVarChar, adParamInput, 400, sValue)
.Parameters.Append .CreateParameter("#fValue", adDouble, adParamInput, , fValue)
.Parameters.Append .CreateParameter("#bValue", adBoolean, adParamInput, , bValue)
.Parameters.Append .CreateParameter("#dValue", adDate, adParamInput, , dValue)
.Parameters.Append .CreateParameter("#FileID", adBigInt, adParamInput, , rstOut)
Set rst = .Execute
End With
Set cmd = New ADODB.Command
Next UploadRow
'Turn off ErrorHandler & Exit Sub
On Error GoTo 0
Exit Sub
ErrorHandler:
MsgBox "There was an Error Uploading your data" & vbNewLine & vbNewLine & "An Automated Email has been sent to Sai Latha Suresh from Acturaial"
On Error GoTo 0
End
End Sub
You are using Execute on your Recordset, when you should be using Execute on your Command object.
From Excel to SQL Server? Try it this way.
Sub Rectangle1_Click()
'TRUSTED CONNECTION
On Error GoTo errH
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strPath As String
Dim intImportRow As Integer
Dim strFirstName, strLastName As String
Dim server, username, password, table, database As String
With Sheets("Sheet1")
server = .TextBox1.Text
table = .TextBox4.Text
database = .TextBox5.Text
If con.State <> 1 Then
con.Open "Provider=SQLOLEDB;Data Source=" & server & ";Initial Catalog=" & database & ";Integrated Security=SSPI;"
'con.Open
End If
'this is the TRUSTED connection string
Set rs.ActiveConnection = con
'delete all records first if checkbox checked
If .CheckBox1 Then
con.Execute "delete from tbl_demo"
End If
'set first row with records to import
'you could also just loop thru a range if you want.
intImportRow = 10
Do Until .Cells(intImportRow, 1) = ""
strFirstName = .Cells(intImportRow, 1)
strLastName = .Cells(intImportRow, 2)
'insert row into database
con.Execute "insert into tbl_demo (firstname, lastname) values ('" & strFirstName & "', '" & strLastName & "')"
intImportRow = intImportRow + 1
Loop
MsgBox "Done importing", vbInformation
con.Close
Set con = Nothing
End With
Exit Sub
errH:
MsgBox Err.Description
End Sub
My setup looks like this.
Also.......Excel VBA - Update SQL Server Table:
http://www.cnblogs.com/anorthwolf/archive/2012/04/25/2470250.html
http://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm
...More
http://www.ozgrid.com/forum/showthread.php?t=169953
http://stackoverflow.com/questions/2567150/excel-vba-sql-data
http://msgroups.net/microsoft.public.excel.programming/vba-to-export-large-tables/61433
http://www.codeproject.com/Questions/475817/Howplustoplusupdateplussqlplusserverplusdataplusfr
http://www.excelguru.ca/forums/showthread.php?992-SQL-Select-Insert-Update-queries-from-Excel-vba
http://www.mrexcel.com/forum/excel-questions/617303-updating-records-access-table-using-excel-visual-basic-applications.html
http://www.excelforum.com/excel-programming-vba-macros/501147-how-to-use-vba-to-update-a-sql-server-table-from-a-spreadsheet.html

passing recordset to stored procedure in MS access

So, I am currently working on an app where I need to call a stored procedure that takes a User defined table as a parameter. In .NET I am able to just pass the data in a datatable, but in MS Access VBA I am having difficulty passing an ADO recordset to the stored procedure as the user defined table.
Private Sub DeleteRecords()
On Error GoTo Err_DeleteRecords
Dim cnn As ADODB.Connection, cmd As New ADODB.Command, param As New ADODB.Parameter
Dim i As Integer
Dim rs As ADODB.Recordset
Dim text As String
Dim gs As String
Set cnn = CurrentProject.Connection
gs = "DECLARE #StagingRecsToDelete StagingRecsToDelete_UDT; SELECT * FROM #StagingRecsToDelete"
Set rs = New ADODB.Recordset
rs.Open gs, cnn, adOpenKeyset, adLockOptimistic
If rs.RecordCount = 0 Then
For i = 0 To Me.lstFingerPrintServiceStaging.ListCount - 1
If Me.lstFingerPrintServiceStaging.Selected(i) Then
text = text + Me.lstFingerPrintServiceStaging.Column(0, i)
rs.AddNew
rs!intFingerPrintServiceStagingID = text
End If
Next i
End If
If rs.RecordCount > 0 Then
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "dbo.SPFingerPrintDeleteErrors"
Set param = cmd.CreateParameter("#ReturnValue", adInteger, adParamReturnValue)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("StagingRecsToDelete_UDT", adVarient, adParamInput, , rs)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("#ErrNbr", adInteger, adParamOutput)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("#ErrMsg", adVarChar, adParamOutput, 8000)
cmd.Parameters.Append param
cmd.Execute
End If
Select Case cmd.Parameters("#ReturnValue").Value
Case 1 'System error
MsgBox cmd.Parameters("#ErrMsg").Value, vbOKOnly + vbInformation, gApplicationTitle
Exit Sub
Case 0 'Succeeds
MsgBox "The Selected records have been successfully deleted.", vbOKOnly + vbInformation, gApplicationTitle
Case -1 'User Error
MsgBox cmd.Parameters("#ErrMsg").Value, vbOKOnly + vbInformation, gApplicationTitle
Exit Sub
End Select
cnn.Close
Set cnn = Nothing
Exit_DeleteRecords:
Exit Sub
Err_DeleteRecords:
MsgBox "Form=" & Me.Name & ", Function=DeleteRecords" & vbCrLf & "Err#=" &
Err & " " & Error$
Resume Exit_DeleteRecords
End Sub
For the most part, all of it works, but I do not know what datatype to set the UDT to when I pass it to the stored procedure.
The MS Access (DAO) does not support it.
You can create an XML with your data and pass it as SP param or insert it into a temporary table one by one fisrt.

Classic Asp Secure Insert Statement Form to Database

I have an online form, data from there needs to be entered into a MSSQL database. I'm trying to create a secure insert statement. With the following code I get this error.
Microsoft OLE DB Provider for SQL Server error '80040e5d'
Parameter name is unrecognized.
<%#language="vbscript" codepage="65001" %>
<% option explicit %>
Dim Form_Name
Dim Form_Email
Form_Name= ProtectSQL(request.Form("Name"))
Form_Email= ProtectSQL(Request.Form("Email"))
Dim objConn
set objConn = Server.CreateObject("ADODB.Connection")
Dim strConn
strConn="provider=SQLOLEDB;Server=localhost;Database=dbname;Uid=username;Pwd=password;"
objConn.open strConn
Dim DateSubmitted
DateSubmitted=now()
Dim strSQL
strSQL = "INSERT INTO tablename(DateSubmitted, Name, Email) VALUES('" & DateSubmitted & "', ?, ?)"
Dim objCmd
set objCmd = Server.Createobject("ADODB.Command")
objCmd.ActiveConnection = objConn
objCmd.CommandText = strSQL
objCmd.CommandType = adCmdText
objCmd.NamedParameters = true
Dim objParam1
Set objParam1 = objCmd.CreateParameter("Name", adVarChar, adParamInput, Len(Form_Name), Form_Name)
objCmd.Parameters.Append objParam1
Dim objparam2
Set objparam2 = objCmd.CreateParameter("Email", adVarChar, adParamInput, Len(Form_Email), Form_Email)
objCmd.Parameters.Append objparam2
objCmd.Execute, , adCmdText And adExecuteNoRecords
objConn.close
Set objConn = Nothing
I have also tried
strSQL = "INSERT into tablename(DateSubmitted,Name,Email)values('" & DateSubmitted & "',#Name,#Email)"
objCmd.Parameters.Append objCmd.CreateParameter("#Name",adVarChar,adParamInput,100,Form_Name)
objCmd.Parameters.Append objCmd.CreateParameter("#Email",adVarChar,adParamInput,100,Form_Email)
With this I get Must declare the scalar variable "#Name".
Both error messages reference the objCmd.Execute line
Is there a better way to do an insert statement? I don't need a recordset with this.
You have 5 placeholders in
strSQL = "INSERT INTO tablename(DateSubmitted, Name, Email) VALUES('" & DateSubmitted & "', ?, ?, ?, ?, ?)"
but add only 2 parameters.
I use code like the following code to perform parameterized queries in classic asp:
public sub sql_execute(sql, parameterArray)
dim cnx
Set cnx=CreateObject("ADODB.Connection")
cnx.Open wfDataConnection
if isArray(parameterArray) then
dim cmd, i
Set cmd = CreateObject("ADODB.Command")
With cmd
.CommandText = sql
.CommandType = adCmdText
.ActiveConnection = cnx
for each i in parameterArray
.Parameters.Append .CreateParameter(i(0), i(1), i(2), i(3), i(4))
next
end with
cmd.execute rowsAffected, , adExecuteNoRecords
else
cnx.execute sql, rowsAffected, adExecuteNoRecords
end if
end sub
Calling it like so:
dim sql, parameterArray
sql = "INSERT INTO table (val1, val2) VALUES (?, ?)"
paramaterArray = Array(_
Array("#p1", adInteger, adParamInput, , val1)_
, Array("#p2", adVarChar, adParamInput, 255, val2)_
)
sql_execute sql, parameterArray
I'm not too sure about the variable names (#p1, #p2, etc) when creating parameters. It doesn't seem to matter what you call the variables, but they do require some kind of name in order for it to work.

Executing msdb.dbo.sp_send_dbmail via ADO from within Excel's vba

I'm trying to run the following:
Sub sendMailViaADO()
Dim cmdStoredFunct As ADODB.Command
Dim r As ADODB.Recordset
Dim strConn As String
strConn = _
"PROVIDER=SQLOLEDB.1;" & _
"P-----D=xxxxx;" & _
"PERSIST SECURITY INFO=True;" & _
"USER ID=yyyyyy;" & _
"INITIAL CATALOG=xxxxx;" & _
"DATA SOURCE=xxxxx;" & _
"USE PROCEDURE FOR PREPARE=1;" & _
"AUTO TRANSLATE=True;" & _
"CONNECT TIMEOUT=0;" & _
"COMMAND TIMEMOUT=0" & _
"PACKET SIZE=4096;" & _
"USE ENCRYPTION FOR DATA=False;" & _
"TAG WITH COLUMN COLLATION WHEN POSSIBLE=False"
Set c= New ADODB.Connection
c.ConnectionString = strConn
c.CommandTimeout = 0
c.Open
Set cmdStoredFunct = New ADODB.Command
Set cmdStoredFunct.ActiveConnection = c
Set r = New ADODB.Recordset
With cmdStoredFunct
.CommandText = "msdb..sp_send_dbmail"
.CommandText = adCmdStoredProc
.Parameters.Append .CreateParameter("#recipients", adVarWChar, adParamInput, 50, "me#me.co.uk;")
.Parameters.Append .CreateParameter("#subject", adVarWChar, adParamInput, 50, "xxx")
.Parameters.Append .CreateParameter("#body", adVarWChar, adParamInput, 50, "yyy")
Set r = .Execute
End With
'>>>
'>>>is there another way like the following ?
'Dim sTemp1
'sTemp1 = "{call msdb.dbo.sp_send_dbmail('me#me.co.uk', 'xxx', 'yyy')}"
'>>>
If Not (cmdStoredFunct Is Nothing) Then
Set cmdStoredFunct.ActiveConnection = Nothing
Set cmdStoredFunct = Nothing
End If
If Not (c Is Nothing) Then
If (c.State And 1) = 1 Then c.Close
End If
End Sub
It is erroring on the execute command Set r = .Execute with this message:
Looks to me like it is finding the stored proc ok but that the string it is using is causing this mysterious exception.
How do I fix this?
As an example if you want to avoid using a command object:
Dim sSQL as String
sSQL =
"EXEC msdb.dbo.sp_send_dbmail " & _
#recipients='me#me.co.uk'," & _
#subject='xxx'," & _
#body='yyy'"
Call r.Open(sSQL,c)
People will huff and puff about SQL injection but thats the least of your worries.

How to return values from a SQL Server Stored Procedure and Utilise them in Access VBA

I've set up a Stored Procedure in SQL Server that works fine. I can now call it from VBA, but want to return a value to know if there were any errors etc. The last parameter in my SP is set up as OUTPUT:
#DataSetID int = 0,
#Destination char(1)='-',
#errStatusOK bit OUTPUT
My VBA to call the SP is below, but it won't work now, after adding the new parameter and I'm not sure where I'm going wrong, I keep getting 3708 - Parameter object is improperly defined. Inconsistent or incomplete information was provided.:
Set cnn = New adodb.Connection
cnn.ConnectionString =
"DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"
cnn.Open cnn.ConnectionString
Set cmd = New adodb.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "stprMoveDataSet"
Set param = cmd.CreateParameter
("#DataSetID", adInteger, adParamInput, , stDataSet)
cmd.Parameters.Append param
Set param = cmd.CreateParameter
("#Destination", adChar, adParamInput, 1, stDestination)
cmd.Parameters.Append param
Set param = cmd.CreateParameter
("#errStatusOK", adBit, adParamReturnValue)
cmd.Parameters.Append param
rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.Open cmd
How can I get the vba to work with the OUTPUT parameter and make the return value 'readable' by the vba.
EDIT - I've changed the question to be more specifically about returning values and not just about using OUTPUT Parameters.
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
Set cnn = New adodb.Connection
cnn.ConnectionString =
"DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"
cnn.Open cnn.ConnectionString
Set cmd = New adodb.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "stprMoveDataSet"
Set param1 = cmd.CreateParameter
("#DataSetID", adInteger, adParamInput, , stDataSet)
cmd.Parameters.Append param
Set param2 = cmd.CreateParameter
("#Destination", adChar, adParamInput, 1, stDestination)
cmd.Parameters.Append param
Set param3 = cmd.CreateParameter
("#errStatusOK", adBit, adParamOutput, , adParamReturnValue)
cmd.Parameters.Append param
rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
rs.Open cmd
I'd initially looked at OUTPUT Parameters, but could not find out how to get them back to Access (in VBA) to then provide feedback to the user. A colleague suggested using a SELECT in the Stored procedure and to use this.
STORED PROCEDURE:
Added the following at the end:
SELECT #errStatusOK as errStatusOK, #countCurrent as countCurrent, #countHistorical as countHistorical
VBA:
Dim cnn As ADODB.Connection
Dim cmd As New ADODB.Command, rs As New ADODB.Recordset, param As New ADODB.Parameter
Dim fld As ADODB.Field
Dim stMessage As String
Set cnn = New ADODB.Connection
cnn.ConnectionString = "DRIVER=SQL Server;SERVER=SERVER\SERVER;DATABASE=a_db;Trusted_Connection=Yes"
cnn.Open cnn.ConnectionString
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "stprMoveDataSet"
Set param = cmd.CreateParameter("#DataSetID", adInteger, adParamInput, , stDataSet)
cmd.Parameters.Append param
Set param = cmd.CreateParameter("#Destination", adChar, adParamInput, 1, stDestination)
cmd.Parameters.Append param
rs.CursorType = adOpenStatic
rs.CursorLocation = adUseClient
rs.LockType = adLockOptimistic
'rs.Open cmd
Set rs = cmd.Execute
If rs!errstatusok = True Then
stMessage = "Operation appears to have been successful, check the DataSets Listing..." & Chr(13) & "Also, the Server returned the following information: ["
Else
stMessage = "Operation appears to have failed, check the DataSets Listing..." & Chr(13) & "Also, the Server returned the following information: ["
End If
For Each fld In rs.Fields
stMessage = stMessage & "| " & fld.Name & " / " & fld.Value & " |"
Next fld
stMessage = stMessage & "]"
MsgBox stMessage
This returns the folliwing:
Operation appears to have failed, check the DataSets Listing...
Also, the Server returned the following information: [| errStatusOK / False || countCurrent / 0 || countHistorical / 10 |]
Among the other parameter enumerations from which "adParamInput" is taken, another is "adParamOutput", which is to indicate an out parameter from a stored procedure, and "adParamInputOutput" for a parameter which goes "both directions," as it were. In your case, I believe "adParamOutput" would be appropriate. I hope this is what you're looking for.

Resources