从 VBA 运行 SQL 服务器存储过程

Question

这是我的存储过程，在 SQL Server Management Studio 中运行良好。

exec GroupCommissions @GroupNumberEntry = '01142' 

应该产生一个数据表。

我正在尝试使用以下代码在 vba 中运行它：

 Dim rs As ADODB.Recordset
    Dim cnSQL As ADODB.Connection
    Dim sqlcommand As ADODB.Command, prm As Object

    Set cnSQL = New ADODB.Connection
    cnSQL.Open "Provider=SQLOLEDB; Data Source=bddc1didw1;Initial Catalog=Actuarial; Trusted_connection=Yes; Integrated Security='SSPI'"

    Set sqlcommand = New ADODB.Command
    sqlcommand.ActiveConnection = cnSQL

    sqlcommand.CommandType = adCmdStoredProc
    sqlcommand.CommandText = "GroupCommissions"
    Set prm = sqlcommand.CreateParameter("GroupNumberEntry", adParamInput)
    sqlcommand.Parameters.Append prm
    sqlcommand.Parameters("GroupNumberEntry").Value = "01142"

    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockOptimistic
    rs.Open sqlcommand

    ActiveSheet.Range("a3").CopyFromRecordset rs

但它只是返回空白，我无法弄清楚我做错了什么。 还有一种更简单的方法可以做到这一点吗？

正如下面所讨论的，我已经设法通过将 SET NOCOUNT ON 添加到原始存储过程来解决这个问题。 我现在的问题是我想在相同的代码中执行第二个存储过程，但它似乎只适用于一个。 但是，它们都单独工作。 所以要么我必须重新打开连接，要么在定义的变量上使用 2？ 这是代码：

Dim rs As ADODB.Recordset

    Dim cnSQL As ADODB.Connection
    Dim sqlcommand As ADODB.Command, prm As Object, prm2 As Object

    Set cnSQL = New ADODB.Connection
    cnSQL.Open "Provider=SQLOLEDB; Data Source=bddc1didw1;Initial Catalog=Actuarial; Trusted_connection=Yes; Integrated Security='SSPI'"

    Set sqlcommand = New ADODB.Command


    sqlcommand.ActiveConnection = cnSQL


'groupdates

    sqlcommand.CommandType = adCmdStoredProc
    sqlcommand.CommandText = "GroupDate"
    Set prm = sqlcommand.CreateParameter("GroupNumberEntry", adVarChar, adParamInput, 5)
    Set prm2 = sqlcommand.CreateParameter("ValuationDateEntry", adDate, adParamInput)
    sqlcommand.Parameters.Append prm
    sqlcommand.Parameters.Append prm2

    sqlcommand.Parameters("GroupNumberEntry").Value = "01132"
    sqlcommand.Parameters("ValuationDateEntry").Value = "08-31-2019"


    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockOptimistic
    rs.Open sqlcommand

    ActiveSheet.Range("a2").CopyFromRecordset rs



    'GroupCommissions


    sqlcommand.CommandType = adCmdStoredProc
    sqlcommand.CommandText = "GroupCommissions"
    Set prm = sqlcommand.CreateParameter("GroupNumberEntry", adVarChar, adParamInput, 5)

    sqlcommand.Parameters.Append prm
    sqlcommand.Parameters("GroupNumberEntry").Value = "01132"

    Set rs = New ADODB.Recordset
    rs.CursorType = adOpenStatic
    rs.LockType = adLockOptimistic
    rs.Open sqlcommand

    ActiveSheet.Range("DB2").CopyFromRecordset rs

Answer 1

尝试用以下内容替换该行：

Set prm = sqlcommand.CreateParameter("GroupNumberEntry", adVarChar, GroupNumberEntry, 255)

根据 proc 的定义方式设置字段类型和长度。

您的代码对我来说看起来不错，所以我将其复制到 Excel (2016 ...) 并尝试了它。 它在该行上给了我一个错误，但是将其他参数值添加到CreateParameter解决了这个问题。 耸耸肩没关系，因为这些是可选参数，除非提供者级别可能存在某些问题。

Answer 2

您可以尝试直接发送 SQL PROCEDURE 作为 CALL function。 看看这个：

Public connDB As New ADODB.Connection
Public rs As New ADODB.Recordset
Public strSQL As String
Public strConnectionstring As String
Public strServer As String
Public strDBase As String
Public strUser As String
Public strPwd As String
Public PayrollDate As String

Sub WriteStoredProcedure()
     PayrollDate = "2017/05/25"
     Call ConnectDatabase
     On Error GoTo errSP
     strSQL = "EXEC spAgeRange '" & PayrollDate & "'"
     connDB.Execute (strSQL)
     Exit Sub
errSP:
MsgBox Err.Description
End Sub

Sub ConnectDatabase()
     If connDB.State = 1 Then connDB.Close
     On Error GoTo ErrConnect
     strServer = "SERVERNAME" ‘The name or IP Address of the SQL Server
     strDBase = "TestDB"
     strUser = "" 'leave this blank for Windows authentication
     strPwd = ""

     If strPwd > "" Then
         strConnectionstring = "DRIVER={SQL Server};Server=" & strServer & ";Database=" & strDBase & ";Uid=" & strUser & ";Pwd=" & strPwd & ";Connection Timeout=30;"
     Else
         strConnectionstring = "DRIVER={SQL Server};SERVER=" & strServer & ";Trusted_Connection=yes;DATABASE=" &    strDBase 'Windows authentication
     End If
     connDB.ConnectionTimeout = 30
     connDB.Open strConnectionstring
Exit Sub
ErrConnect:
     MsgBox Err.Description
End Sub