I am getting the error for the ws.Cells(2, 2).CopyFromRecordset adoDbRs line:
operation is not allowed when the object is closed
If I remove the JOIN to the temp table #reporttable, it works fine, I feel like the recordset is empty because I'm sending it to a temp table and then trying to JOIN and pull out of that, but I'm not sure how to take the output from the final select query properly, it works fine when reformatted and typed directly into the SQL Server.
Secondary question:
Since I have been struggling with this, but can always get it working on the server, is there a way to setup a custom call to the SQL Server which is like command(var1,var2,var3) which runs a stored brick of working code on the SQL Server and returns what it returns, instead of my current process which is get it to work on the SQL Server and then struggle to adapt it into VBA?
Private Sub Run_Summary_Click()
Dim adoDbConn As New ADODB.Connection
Dim adoDbRs As New ADODB.Recordset
Dim selectCmd As New ADODB.Command
Dim Machvar As Integer
Machvar = Worksheets("SumImport").Range("A1").Value
Dim DateYMD As String
Dim DateStart As Date
Dim DateEnd As Date
Dim SQL As String
DateYMD = Format(Worksheets("SumImport").Range("A2").Value, "YYYY-MM-DD")
' Open connection to the SQL Server database
adoDbConn.Open "Provider=SQLOLEDB; Data Source=********; Initial Catalog=SMP; User Id=Query;"
' Execute the select query
selectCmd.ActiveConnection = adoDbConn
selectCmd.CommandText = "IF OBJECT_ID('tempdb.#reporttable2') IS NOT NULL DROP TABLE #reporttable2 " & _
" SELECT " & _
" DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5)*5, '20000101') as Date_Time " & _
" ,max(Part_Count)-min(Part_Count) as PartsMade " & _
" ,max(convert(char(5), DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5)*5, '20000101'), 108)) as times " & _
" ,max(Alarm_Light) as AlarmLight " & _
" ,max(PV_Alarm) as AlarmCode " & _
" INTO #reporttable2 " & _
" FROM [33_TestImport]" & _
" Where [DateTime]>= DateAdd(Hour, DateDiff(Hour, 0, '" & DateYMD & "')-0, 0) AND [DateTime]<= DateAdd(Hour, DateDiff(Hour, 0, '" & DateYMD & "')+24, 0) " & _
" AND Machine_Number = " & Machvar & " " & _
" Group BY DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5)*5, '20000101') " & _
" select * " & _
" from #reporttable2 p " & _
" right join SMP.dbo.Timerange c " & _
" ON c.mins = p.times " & _
" order by mins "
Set adoDbRs = selectCmd.Execute(, , adCmdText)
' Clear the contents in cells where we're going to display the result
Dim cellRange As Range
Dim ws As Worksheet
Set ws = Worksheets("SumImport")
ws.Activate
Set cellRange = Worksheets("SumImport").Range("B1:M1800")
cellRange.ClearContents
' Activate the Worksheet
Set ws = Worksheets("SumImport")
ws.Activate
' Put the query results starting from cell B2
ws.Cells(2, 2).CopyFromRecordset adoDbRs
' Set the column header
ws.Cells(1, 2) = "DateTime"
ws.Cells(1, 3) = "Part Total"
ws.Cells(1, 4) = "TimeSync"
ws.Cells(1, 5) = "Alarm Light"
ws.Cells(1, 6) = "Alarm Code"
' Close the connection and free the memory
Set adoDbRs = Nothing
Set selectCmd = Nothing
adoDbConn.Close
Set adoDbConn = Nothing
Set ws = Worksheets("Summary")
ws.Activate
End Sub
And the code that works in SQL directly
drop table #reporttable2
declare #dateget as date
set #Dateget = '2020-03-19'
SELECT
DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5)*5, '20000101') as Date_Time
,max(Part_Count)-min(Part_Count) as PartsMade
,max(convert(char(5), DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5)*5, '20000101'), 108)) as times
into #reporttable2
FROM
[SMP].[dbo].[33_TestImport]
where [DateTime]>= DateAdd(Hour, DateDiff(Hour, 0, #Dateget)-1, 0)
and [DateTime]<= DateAdd(Hour, DateDiff(Hour, 0, #Dateget)+24, 0)
GROUP BY
DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5)*5, '20000101')
select *
from #reporttable2 p
right join SMP.dbo.Timerange c
ON c.mins = p.times
order by mins
In VBA, ADO connections do not support multiple line SQL commands. Therefore, the recordset is possibly being created based on the very first line of SQL or the DROP statement and may not return anything.
However, looking closer at your situation, consider a Common Table Expression (CTE) and avoid the need of a temp table and then integrate a parameterized query for your date variable. Doing so, your original 5 statements convert to a single statement:
SQL
WITH reporttable2 AS (
SELECT
DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5) * 5, '20000101') AS Date_Time
, MAX(Part_Count) - MIN(Part_Count) AS PartsMade
, MAX(CONVERT(CHAR(5), DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5)*5, '20000101'), 108)) AS times
FROM
[SMP].[dbo].[33_TestImport]
WHERE [DateTime] >= DATEADD(Hour, DATEDIFF(Hour, 0, #Dateget) - 1, 0)
AND [DateTime] <= DATEADD(Hour, DATEDIFF(Hour, 0, #Dateget) + 24, 0)
GROUP BY
DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5) * 5, '20000101')
)
SELECT *
FROM reporttable2 p
RIGHT JOIN SMP.dbo.Timerange c
ON c.mins = p.times
ORDER BY mins
VBA
' ASSIGN DATE (NOT STRING) VARIABLE FOR PARAMETER
myDate = Worksheets("SumImport").Range("A2").Value
' PREPARED STATEMENT WITH QMARKS ?
sql = "WITH reporttable2 AS ( " _
& " SELECT " _
& " DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5) * 5, '20000101') AS Date_Time " _
& " , MAX(Part_Count) - MIN(Part_Count) AS PartsMade " _
& " , MAX(CONVERT(CHAR(5), DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5)*5, '20000101'), 108)) AS times " _
& " FROM " _
& " [SMP].[dbo].[33_TestImport] " _
& " WHERE [DateTime] >= DATEADD(Hour, DATEDIFF(Hour, 0, ?) - 1, 0) " _
& " AND [DateTime] <= DATEADD(Hour, DATEDIFF(Hour, 0, ?) + 24, 0) " _
& " GROUP BY " _
& " DATEADD(MINUTE, (DATEDIFF(MINUTE, '20000101', DateTime) / 5) * 5, '20000101') " _
& ")" _
& " " _
& " SELECT * " _
& " FROM reporttable2 p " _
& " RIGHT JOIN SMP.dbo.Timerange c " _
& " ON c.mins = p.times " _
& " ORDER BY mins"
With selectCmd
.ActiveConnection = adoDbConn
.CommandText = sql
.CommandType = adCmdText
' BIND TWO PARAM VALUES
.Parameters.Append .CreateParameter("param1", adDate, adParamInput, , myDate)
.Parameters.Append .CreateParameter("param2", adDate, adParamInput, , myDate)
' ASSIGN RECORDSET TO RESULT
Set adoDbRs = .Execute
End With
I have an old slow procedure in VB6 using ADO to run many sql queries in many calls. Its taking too many hours. I want to test if sending all queries in one single query (most of them are just update or insert) to save network and calling time. How can I implement this, and also suggests if this would save time and boost performance?
qry = "Update table1 Set col1 = 'eerere' Where 1=1"
qry = qry & vbCrLf & " AND MyID = " & MyID & vbCrLf
ExecSQL qry, DBCon, adAsyncExecute
qry = "Insert Into TableMain"
qry = qry & "Select col1,col2,col3 from Table2 Where 1=1"
qry = qry & vbCrLf & " AND MyID = " & MyID & vbCrLf
ExecSQL qry, DBCon, adAsyncExecute
qry = "Update table5 Set col1 = 'eerere' Where 1=1"
qry = qry & vbCrLf & " AND MyID = " & MyID & vbCrLf
ExecSQL qry, DBCon, adAsyncExecute
You can combine them into one call by separating the commands with a semi-colon:
qry = "Update table1 Set col1 = 'eerere' Where 1=1"
qry = qry & vbCrLf & " AND MyID = " & MyID & "; " & vbCrLf
qry = qry & "Insert Into TableMain"
qry = qry & "Select col1,col2,col3 from Table2 Where 1=1"
qry = qry & vbCrLf & " AND MyID = " & MyID & "; " & vbCrLf
It will probably give you some small performance improvement, if it doesn't cause any errors.
The function below is trying to get the earliest date from a table with 3 dates, one for each type of user, care, sales and manager. This is to build up the diary system by first finding the first date in the diary dates. It's working for some users, but in one case the values do not return at and it gives null.
Private Function GetEarliestDate() As Date
Dim strSQL As String
Dim cmd As New SqlCommand
Dim dDate As Date
Try
strSQL = "Select dT.RecordID, MIN(dT.inDate) As [EarliestDate]
FROM (
Select RecordID, SentDate As [inDate]
From tblOrderDetails Where Flagged = 0 AND SalesID = '" & gUserID & "'
UNION ALL
Select RecordID, DiaryDate AS [inDate]
From tblOrderDetails
Where Flagged=0 And ManID ='" & gUserID & "'
UNION ALL
Select RecordID, CareDate As [inDate]
From tblOrderDetails
Where Flagged = 0 And CareID ='" & gUserID & "'
) As dT Group By RecordID"
cmd.CommandText = strSQL
cmd.Connection = CnMaster
cmd.CommandType = CommandType.Text
Dim RecordCount As Integer
RecordCount = 0
dDate = DateTime.MaxValue
Using reader As SqlDataReader = cmd.ExecuteReader()
While (reader.Read())
RecordCount += 1
Dim dt As DateTime = reader.GetDateTime(1)
If dt < dDate Then
dDate = dt
End If
End While
If dDate = DateTime.MaxValue Then
dDate = DateTime.MinValue
End If
End Using
cmd.Dispose()
Return dDate
Catch ex As Exception
Error_Handler(ex, "GetEarliestDate", "Unable to Get The Earliest Date!")
End Try
Put in all 3 queries additional where:
where SentDate is not null ...
where DiaryDate is not null ...
where CareDate is not null ...
How can I convert my strings into a date or datetime datatype in vb.net?
These are my strings that are date and time with this format:
Dim sDate,sTime String
Dim myDate,myTime,dateToSave as Date
sDate = '11/25/13'
sTime = '16:30:05'
I wanted to convert it to a date with this expected output:
myDate = '11/25/2013'
myTime = '16:30:05'
dateToSave = '11/25/2013 16:30:05'
How can I do this so that I can save it to sql table with datatype of datetime?
Declare myDate, myTime and dateToSave as DateTime. Then you can use DateTime.TryParse or DateTime.TryParseExact to convert a string into a DateTime.
PS: I'm reading the sql-server tag in your question. Please remember to pass the values to the database server using parameterized queries - this will save you the next question about how to insert dates and times into the database.
Something as simple as myDate = CDate(sDate & " " & sTime) will work. But also, if you're going to insert or update a SQL Server table that has a column with one of the date/time data types, you can just insert the value as is and it will be stored with the proper data type:
String.Format("INSERT INTO MyTable (MyDateColumn) VALUES({0})", dDateToSave)
dim QueryString as string = "Update someTable set someDate = '" & sDate & " " & sTime & "'"
or
dim datetosave as string = sDate & " " & sTime
dim QueryString as string = "Update someTable set someDate = '" & dateToSave & "'"
I am attempting to write the results of a query in specific spaces on a spreadsheet. The SQL creates temporary tables for use during the query and then drops them at the end. Is this the cause of my problem? I have posted my source code below. The error is thrown on line 530. Is there a better way to do this?
410 With wsSheet
420 Set rnStart = Sheets("Discharge Information").Range("Q51")
430 End With
440 strSQL = "create table #encounters ( DischargeKey int,EncounterID varchar(25)) insert into #encounters " & _
"SELECT top 30 dischargekey,encounternumber from discharges order by dischargedate desc " & _
"CREATE TABLE #icd9_poa(DischargeKey int,ICD9 nvarchar(max),POA nvarchar(max)) " & _
"DECLARE #i int, #f int SET #i = 1 SET #f = ( " & _
"SELECT REPLACE(column_name,'icd9_POA_','') FROM information_schema.Columns WHERE column_name LIKE 'icd9_POA_%' AND table_name = 'temp_discharge' AND ordinal_position IN ( " & _
"SELECT Max (ordinal_position) FROM information_schema.Columns " & _
"WHERE column_name LIKE 'icd9_POA_%' AND table_name = 'temp_discharge')) " & _
"WHILE #i <= #f " & _
"BEGIN IF #i=1 " & _
"BEGIN INSERT INTO #icd9_poa " & _
"SELECT d.DischargeKey,i.icd9code,poa.poa " & _
"FROM discharges d " & _
"inner join #encounters e on e.dischargekey = d.dischargekey INNER join icd9diagnosesbridge icb on icb.discharge=d.dischargekey INNER join icd9diagnoses i on icb.icd9 = i.icd9key INNER join presentonadmission poa on icb.presentonadmission = poa.poakey " & _
"WHERE icb.Icd9Sequence = 1 End " & _
"IF #I>1 BEGIN " & _
"Update t SET t.Icd9 = t.Icd9 + ', '+i.Icd9Code,t.poa = t.poa + ', '+ poa.poa " & _
"FROM #Icd9_poa t" & _
"INNER JOIN Discharges d ON (t.DischargeKey=d.DischargeKey) INNER JOIN Icd9DiagnosesBridge icb ON (icb.Discharge=d.DischargeKey) INNER JOIN Icd9Diagnoses i ON (icb.Icd9=i.icd9Key) INNER JOIN PresentOnAdmission poa ON (icb.PresentOnAdmission=poa.PoaKey) " & _
"WHERE icb.Icd9Sequence=#i End " & _
"SET #i = #i + 1 End " & _
"select icd9, poa from #icd9_poa " & _
"drop table #icd9_poa " & _
"drop table #encounters "
450 Set cnt = New ADODB.Connection
460
470 With cnt
480 .CursorLocation = adUseClient
490 .Open ConnectionString
500 .CommandTimeout = 0
510 Set rst = .Execute(strSQL)
520 End With
530 rnStart.CopyFromRecordset rst
At a very quick look, I would try this method:
RETURNS #icd9_poa TABLE (
DischargeKey int,
ICD9 nvarchar(max),
POA nvarchar(max))
AS
BEGIN
... then insert your SQL (remembering that icd9_poa is already defined)
END
Don't bother with dropping temp tables - SQL Server will remove them as soon as your procedure finishes running
I can't test it fully, as I don't have your data, but this is a method to return a recordset from an SQL procedure.
Deleting the temp tables is not necessary and will not be causing your error.
It looks like your connection has closed by the time you call "CopyFromRecordSet", try moving that call into the "With" block.