尝试使用 VBA excel 运行 SQL 查询时出错
Error while trying to run a SQL query with VBA excel
我正在尝试 运行 VBA 中的 SQL 查询，但出现错误：
Operation is not allowed when the object is closed.
该查询在 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
连接函数、执行结果和显示结果是否设置正确？
在代码中的某些时候，我相信您需要通过以下方式打开记录集对象：
rs.Open
正如 Parfait 在评论中提到的那样，这不是必需的，因为 Execute 方法应该打开 rs（打开 rs 的替代方法参考：https://docs.microsoft.com/en-us/troubleshoot/sql/connect/open-ado-connection-recordset-objects）
另外我想知道你是否需要明确说明 rs 是什么类型的对象：
Dim Rs As adodb.Recordset
oCmd.Execute只能执行一个SQL命令（executes the query, SQL statement, or stored procedure specified in the CommandText ）；您正在尝试执行一批命令：'declare, ... set, ... select'。您只能使用此方法提交一个命令。一种选择是将所有这些批次放入 SQL 服务器的存储过程中，并从 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
特别是对于复杂查询，考虑将 SQL 和 VBA 分开并将 SQL 参数化为带有 qmark 占位符的准备语句。 ADO 支持 ADO command 对象的参数化，巧合的是你已经在使用它了！这使您可以避免任何 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
我正在尝试 运行 VBA 中的 SQL 查询，但出现错误：
Operation is not allowed when the object is closed.
该查询在 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
连接函数、执行结果和显示结果是否设置正确？
在代码中的某些时候，我相信您需要通过以下方式打开记录集对象：
rs.Open
正如 Parfait 在评论中提到的那样，这不是必需的，因为 Execute 方法应该打开 rs（打开 rs 的替代方法参考：https://docs.microsoft.com/en-us/troubleshoot/sql/connect/open-ado-connection-recordset-objects）
另外我想知道你是否需要明确说明 rs 是什么类型的对象：
Dim Rs As adodb.Recordset
oCmd.Execute只能执行一个SQL命令（executes the query, SQL statement, or stored procedure specified in the CommandText ）；您正在尝试执行一批命令：'declare, ... set, ... select'。您只能使用此方法提交一个命令。一种选择是将所有这些批次放入 SQL 服务器的存储过程中，并从 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
特别是对于复杂查询，考虑将 SQL 和 VBA 分开并将 SQL 参数化为带有 qmark 占位符的准备语句。 ADO 支持 ADO command 对象的参数化，巧合的是你已经在使用它了！这使您可以避免任何 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