I am trying to run a SQL query in VBA but I am getting an error:
Operation is not allowed when the object is closed.
The query works perfectly in SQL but I am haven't managed to translate it in VBA code. The error is located at WS.Range("B20").CopyFromRecordset rs line.
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
Are the connect function , execute result and the show results properly set?
CodePudding user response：
Especially for complex queries, consider separating SQL and VBA and parameterizing the SQL as a prepared statement with qmark placeholders. ADO supports parameterization with the ADO command object which coincidentally you already use! This allows you to avoid any DECLARE and messy, even dangerous concatenation. Also, because of parameterization, purposely use date types and avoid any FORMAT or CONVERT needs. You can also avoid #temp1 with a single statement:
SQL (save as .sql or string in an Excel cell)
Query below uses more informative aliases and uses AS operator for column aliasing. Also, all system commands are consistently capitalized for readability. Please note the use of qmarks (?) for parameters and not @ variables. Please test query and adjust as needed.
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 (reads in above query and binds date parameters)
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
CodePudding user response：
At some point in the code I believe you need to open the recordset object via this:
rs.Open
As Parfait mentions in comments this should not be needed as the Execute method should open the rs (reference for alternative ways to open rs: https://docs.microsoft.com/en-us/troubleshoot/sql/connect/open-ado-connection-recordset-objects)
Also I am wondering if you need to explicitly say what sort of object rs is:
Dim Rs As adodb.Recordset
CodePudding user response：
oCmd.Execute can only execute a single SQL Command (executes the query, SQL statement, or stored procedure specified in the CommandText ); you are trying to execute a batch of commands: 'declare, ... set, ... select'. You can submit only one command with this method. One option is to put all this batch in a stored procedure in SQLServer and call it from VBA, or remove the declare/set parts, and replace them with ADO Command parameters.
Example query (you can easily adapt to your query):
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