简体   繁体   中英

Error while trying to run a SQL query with VBA excel

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?

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

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

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://learn.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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM