嘗試使用 VBA 運行 SQL 查詢時出錯 excel

Question

我正在嘗試在 VBA 中運行 SQL 查詢，但出現錯誤：

關閉 object 時不允許操作。

該查詢在 SQL 中完美運行，但我無法在 VBA 代碼中翻譯它。 錯誤位於WS.Range("B20").CopyFromRecordset rs 行。

Private Sub UpdateButton_Click()
    Dim oCon As ADODB.Connection, oCmd As Object
    Dim rs As Object, SQL_1 As String
    Dim WS As Worksheet, n As Long
    
'GET DATES
    Dim StartDate As String, EndDate As String
    With ThisWorkbook.Sheets("A&B Sankey")
        StartDate = Format(.Range("R2").Value, "yyyy-mm-dd hh:MM:ss")
        EndDate = Format(.Range("T2").Value, "yyyy-mm-dd hh:MM:ss")
    End With
    
'CONNECT FUNCTION
    Set oCon = DbConnect
    Set oCmd = CreateObject("ADODB.Command")
    oCmd.CommandTimeout = 0
    oCmd.ActiveConnection = oCon
    
SQL_1 = _
" DECLARE @StartDate nvarchar(20)" & vbCrLf & _
" DECLARE @EndDate nvarchar(20)" & vbCrLf & _
" SET @StartDate ='" & StartDate & "'" & vbCrLf & _
" SET @EndDate ='" & EndDate & "'" & vbCrLf
SQL_1 = SQL_1 & _
" SELECT x.*, y.* INTO #temp1 FROM " & vbCrLf & _
" (SELECT [Charge_slabs_A]=count(CASE WHEN f.[FURNACE_NUMBER] =1 then f.[slab_weight] else null end)," & vbCrLf & _
"[Slab_weight_Discharged_A]=1000*avg(c.[fa_weight])," & vbCrLf & _
"[Avg_Charg_Temp_A]=avg(case when b.[Furnace]='A' then b.[charge_temperature]else null end)" & vbCrLf & _
"" & vbCrLf
    SQL_1 = SQL_1 & _
" FROM fix.dbo.Fce_HD_Hourly a " & vbCrLf & _
" LEFT JOIN ALPHADB.dbo.Mill_Temp_Aims as b on DATEADD(hour, DATEDIFF(hour, 0, b.[charge_time]), 0) = a.[_TimeStamp]" & vbCrLf & _
" LEFT JOIN ALPHADB.dbo.reheats_hourly_data c ON c.[start_time]= a.[_timestamp]" & vbCrLf & _
" LEFT JOIN alphadb.dbo.HFNCPDI f on  f.[counter] = b.[mill_counter]" & vbCrLf & _
" WHERE a.[_TimeStamp] between @StartDate and @EndDate and b.[charge_time] between @StartDate and @EndDate " & vbCrLf & _
" GROUP BY a.[_TimeStamp]) as x " & vbCrLf & _
" FULL OUTER JOIN (SELECT [Avg_DisCharg_Temp_B]=avg(CASE WHEN b.[FURNACE] ='B' then convert(real,isnull (b.[ave_disch_temp],'0')) else null end),[Time]= a.[_TimeStamp] " & vbCrLf & _
" FROM fix.dbo.Fce_HD_Hourly as a" & vbCrLf & _
" LEFT JOIN Mill_Temp_Aims as b on DATEADD(hour, DATEDIFF(hour, 0, b.[discharge_time]), 0) = a.[_TimeStamp]" & vbCrLf & _
" WHERE a.[_TimeStamp] BETWEEN CONVERT(datetime, @StartDate , 120) AND CONVERT(datetime,@EndDate , 120) and b.[discharge_time]  BETWEEN CONVERT(datetime, @StartDate , 120) AND CONVERT(datetime, @EndDate , 120) " & vbCrLf & _
" GROUP BY  a.[_TimeStamp]) AS y ON y.[Time] = x.[_TimeStamp]" & vbCrLf & _
" SELECT [Charge_slabs_A],[Slab_weight_Discharged_A],[Avg_Charg_Temp_A],[Avg_DisCharg_Temp_B]" & vbCrLf & _
" FROM  #temp1 DROP TABLE #temp1"
         
'EXECUTE RESULT
    oCmd.CommandText = SQL_1
    Set rs = oCmd.Execute
    
'SHOW RESULT
    Set WS = ThisWorkbook.Sheets("-Input Data-")
    WS.Range("B20:CC20000").ClearContents
    
    WS.Range("B20").CopyFromRecordset rs           <-------------------ERROR
    
'CLOSE
    oCon.Close
    MsgBox "Result written to " & WS.Name & _
           "For " & StartDate & "-" & EndDate, vbInformation, "Finished"
End Sub

Function DbConnect() As ADODB.Connection
    Dim sConn As String
    sConn = "driver={SQL server}; SERVER=; " & _
            "UID=; PWD=; DATABASE=;"
    Set DbConnect = CreateObject("ADODB.Connection")
    DbConnect.Open sConn
End Function

connect function, execute result 和 show results 是否設置正確？

Answer 1

特別是對於復雜的查詢，考慮將 SQL 和 VBA 分開，並將 SQL 參數化為帶有 qmark 占位符的准備語句。 ADO 支持使用ADO 命令object 進行參數化，巧合的是你已經在使用它了！ 這使您可以避免任何DECLARE和混亂，甚至是危險的串聯。 此外，由於參數化，有目的地使用日期類型並避免任何FORMAT或CONVERT需求。 您還可以使用一條語句避免#temp1 ：

SQL （另存為 sql 或 Excel 單元格中的字符串）

下面的查詢使用信息量更大的別名，並使用AS運算符進行列別名。 此外，為了便於閱讀，所有系統命令都始終大寫。 請注意使用 qmarks ( ? ) 作為參數而不是 @ 變量。 請測試查詢並根據需要進行調整。

SELECT x.[Charge_slabs_A], x.[Slab_weight_Discharged_A],
       x.[AVG_Charg_Temp_A], y.[AVG_DisCharg_Temp_B]
FROM 
   (SELECT COUNT(CASE
                    WHEN h.[FURNACE_NUMBER]=1 
                    THEN h.[slab_weight] 
                    ELSE NULL 
                 END) AS [Charge_slabs_A],
           1000 * AVG(r.[fa_weight]) AS [Slab_weight_Discharged_A],
           AVG(CASE 
                  WHEN m.[Furnace]='A' 
                  THEN m.[charge_temperature]
                  ELSE NULL 
               END) AS [AVG_Charg_Temp_A]
   FROM fix.dbo.Fce_HD_Hourly AS f
   LEFT JOIN ALPHADm.dbo.Mill_Temp_Aims AS m 
        ON DATEADD(HOUR, DATEDIFF(HOUR, 0, m.[charge_time]), 0) = f.[_TimeStamp]
   LEFT JOIN ALPHADm.dbo.reheats_hourly_data AS r 
        ON r.[start_time]= f.[_timestamp]
   LEFT JOIN alphadm.dbo.HFNCPDI h
        ON  h.[counter] = m.[mill_counter]
   WHERE f.[_TimeStamp] BETWEEN ? AND ?
     AND m.[charge_time] BETWEEN ? AND ?
   GROUP BY f.[_TimeStamp]
  ) AS x 
FULL OUTER JOIN 
  (SELECT AVG(CASE 
                 WHEN m.[FURNACE] ='B' 
                 THEN convert(real,isnull (m.[ave_disch_temp],'0')) 
                 ELSE NULL 
              END) AS [AVG_DisCharg_Temp_B],
          f.[_TimeStamp] AS [Time]
   FROM fix.dbo.Fce_HD_Hourly AS f
   LEFT JOIN Mill_Temp_Aims AS m 
        ON DATEADD(HOUR, DATEDIFF(HOUR, 0, m.[discharge_time]), 0) = f.[_TimeStamp]
   WHERE f.[_TimeStamp] BETWEEN ? AND ?
     AND m.[discharge_time] BETWEEN ? AND ?
   GROUP BY f.[_TimeStamp]
  ) AS y 
ON y.[Time] = x.[_TimeStamp]

VBA （讀入上述查詢並綁定日期參數）

Private Sub UpdateButton_Click()
    Dim oCon As ADODB.Connection, oCmd As ADODB.Command
    Dim rs As Object, SQL_1 As String
    Dim WS As Worksheet, n As Long
    
'GET DATES
    Dim StartDate As Date, EndDate As Date
    With ThisWorkbook.Sheets("A&B Sankey")
        StartDate = CDate(.Range("R2").Value)
        EndDate = CDate(.Range("T2").Value)
    End With
    
'CONNECT FUNCTION
    Set oCon = DbConnect
    Set oCmd = CreateObject("ADODB.Command")
    oCmd.CommandTimeout = 0
    oCmd.ActiveConnection = oCon
    
'READ IN SQL
   With CreateObject("Scripting.FileSystemObject")
       SQL_1 = .OpenTextFile("C:\path\to\my\SQL\Query.sql", 1).readall
   End With
   ' SQL_1 = ThisWorkbook.Sheets("MySQLSheet").Range("A1")

'EXECUTE RESULT
   With oCmd
       .CommandText = SQL_1
                
       ' BIND ? PARAMETERS IN SQL (USING adDate TYPES)
       For n = 1 to 4
           .Parameters.Append .CreateParameter("startdateparam" & n, adDate, adParamInput, , StartDate)
           .Parameters.Append .CreateParameter("enddateparam" & n, adDate, adParamInput, , EndDate)
       Next n

       ' CREATE RECORDSET
       Set rs = .Execute
    End With
    
'SHOW RESULT
    With ThisWorkbook.Sheets("-Input Data-")
        .Range("B20:CC20000").ClearContents
        .Range("B20").CopyFromRecordset rs
    End With

'CLOSE
    MsgBox "Result written to " & WS.Name & _
           "For " & StartDate & "-" & EndDate, vbInformation, "Finished"
    rs.Close: oCon.Close
    Set rs = Nothing: Set oCmd = Nothing: Set oCon = Nothing
End Sub

Function DbConnect() As ADODB.Connection
    Dim sConn As String
    sConn = "Driver={SQL Server}; SERVER=; " & _
            "UID=; PWD=; DATABASE=;"
    Set DbConnect = CreateObject("ADODB.Connection")
    DbConnect.Open sConn
End Function

Answer 2

oCmd.Execute can only execute a single SQL Command（ executes the query, SQL statement, or stored procedure specified in the CommandText ）； 您正在嘗試執行一批命令：“聲明、...設置、...選擇”。 您只能使用此方法提交一個命令。 一種選擇是將所有這些批處理放在 SQLServer 中的存儲過程中，並從 VBA 調用它，或者刪除 declare/set 部分，並將它們替換為 ADO 命令參數。

示例查詢（您可以輕松適應您的查詢）：

Public Sub DoIt()
  Dim conn As ADODB.Connection, _
      cmd As ADODB.Command, _
      rs As ADODB.Recordset, _
      parmStartDate As ADODB.Parameter, _
      parmEndDate As ADODB.Parameter, _
      strSql As String
  
  Set conn = New ADODB.Connection
  With conn
    .ConnectionString = "driver={SQL server}; SERVER=MYSSINSTANCE; UID=; PWD=; DATABASE=;"
    .Open
    Set cmd = New ADODB.Command
    
    With cmd
        .ActiveConnection = conn
        .CommandText = "select NumDays=datediff(day, ?, ?)"
        .CommandType = adCmdText
        
        Set parmStartDate = .CreateParameter("StartDate", adDBTimeStamp, adParamInput)
        parmStartDate.Value = "2020-01-01"
        .Parameters.Append parmStartDate
        Set parmEndDate = .CreateParameter("EndDate", adDBTimeStamp, adParamInput)
        parmEndDate.Value = "2020-03-05"
        .Parameters.Append parmEndDate
        Set rs = .Execute()
        Debug.Print rs!NumDays
        rs.Close
        Set rs = Nothing
    End With
    .Close
  End With
  Set conn = Nothing
End Sub

Answer 3

在代碼中的某個時刻，我相信您需要通過以下方式打開記錄集 object：

rs.Open

正如 Parfait 在評論中提到的那樣，這不是必需的，因為 Execute 方法應該打開 rs（打開 rs 的替代方法參考： https：https://learn.microsoft.com/en-us/troubleshoot/sql/connect/open-ado -連接記錄集對象）

另外我想知道您是否需要明確說明 object rs 是什么類型：

Dim Rs As adodb.Recordset