從 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