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
While moving back-end from Access .mdb file to SQL Server, the following problem was discovered.
If you join two tables A and B and there are several rows in A for one row in B Access sequentially updates target row in B with each rows of A. SQL Server acts differently (and as written in manual): target row in B is updated by one random row of A.
For MS Access
CurrentDb.Execute "CREATE TABLE A (id int, valA real);"
CurrentDb.Execute "CREATE TABLE B (id int, valB real);"
CurrentDb.Execute "insert into A(id, valA) VALUES (1, 1);"
CurrentDb.Execute "insert into A(id, valA) VALUES (1, 2);"
CurrentDb.Execute "insert into A(id, valA) VALUES (1, 3);"
CurrentDb.Execute "insert into A(id, valA) VALUES (2, 1);"
CurrentDb.Execute "insert into A(id, valA) VALUES (2, 2);"
CurrentDb.Execute "insert into A(id, valA) VALUES (3, 0);"
CurrentDb.Execute "insert into B(id, valB) VALUES (1, 0);"
CurrentDb.Execute "insert into B(id, valB) VALUES (2, 0);"
CurrentDb.Execute "insert into B(id, valB) VALUES (3, 0);"
CurrentDb.Execute "UPDATE A INNER JOIN B ON A.id = B.id SET B.valB = B.valB + A.valA;"
docmd.OpenTable "B"
Access result:
id valB
1 6
2 3
3 0
For SQL Server
CREATE TABLE A (id int, valA real);
insert into A(id, valA) VALUES (1, 1), (1, 2), (1, 3), (2, 1), (2, 2), (3, 0);
CREATE TABLE B (id int, valB real);
insert into B(id, valB) VALUES (1, 0), (2, 0), (3, 0);
UPDATE B SET B.valB = B.valB + A.valA
FROM A INNER JOIN B ON A.id = B.id ;
SELECT * FROM B;
SQL Server result
id valB
1 1
2 1
3 0
I need to get MS Access results in SQL Server. For this small and easy query it is possible to correct command in this way
UPDATE B
SET B.valB = B.valB + AA.valA
FROM (SELECT SUM(valA) as valA, id
FROM A GROUP BY id) AS AA
INNER JOIN B ON AA.id = B.id ;
But I have 150 update queries with 3 to 5 joined tables and it's hard to write parser which could fix them.
There are even such queries to write count of lines in A to B.valB, and it works well in Access, but sets B.valB = 1 at SQL server
UPDATE A INNER JOIN B ON A.id = B.id SET B.valB = B.valB + 1;
Typical four tables query :
UPDATE
vrtReserved
SET
vrtReserved.qtyOutput = Round([vrtReserved].[qtyOutput] + [ComplexRes].[Qty], 3)
FROM
Complex
INNER JOIN ((vrtReserved
INNER JOIN ComplexRes ON (vrtReserved.Code = ComplexRes.Code) AND (vrtReserved.UE = ComplexRes.UE))
INNER JOIN ComplexDetail ON (vrtReserved.flagDAV = ComplexDetail.flagDAV) AND (ComplexRes.CodeComplDetail = ComplexDetail.CodeComplDetail)) ON (vrtReserved.CodeBox = Complex.CodeBox) AND (Complex.CodeCompl = ComplexDetail.CodeCompl) AND (Complex.CodeCompl = ComplexRes.CodeCompl);
Must be rewritten to
WITH CTE AS
(
SELECT vrtReserved.CodeBox, vrtReserved.Code, vrtReserved.UE, vrtReserved.flagDAV, Sum(ComplexRes.Qty) AS [Sum-Qty]
FROM Complex INNER JOIN ((vrtReserved INNER JOIN ComplexRes ON (vrtReserved.UE = ComplexRes.UE) AND (vrtReserved.Code = ComplexRes.Code)) INNER JOIN ComplexDetail ON (ComplexRes.CodeComplDetail = ComplexDetail.CodeComplDetail) AND (vrtReserved.flagDAV = ComplexDetail.flagDAV)) ON (Complex.CodeCompl = ComplexDetail.CodeCompl) AND (Complex.CodeCompl = ComplexRes.CodeCompl) AND (Complex.CodeBox = vrtReserved.CodeBox)
GROUP BY vrtReserved.CodeBox, vrtReserved.Code, vrtReserved.UE, vrtReserved.flagDAV, vrtReserved.qtyOutput
)
UPDATE
vrtReserved
SET
vrtReserved.qtyOutput = Round([vrtReserved].[qtyOutput] + [Sum-Qty], 3)
FROM
vrtReserved
INNER JOIN
CTE
ON (vrtReserved.Code = CTE.Code) AND (vrtReserved.UE = CTE.UE) AND (vrtReserved.flagDAV = CTE.flagDAV) AND (vrtReserved.CodeBox = CTE.CodeBox);
Is there any other way except manual correction of query's text to reproduce MS Access results at SQL Server?
Interesting observation! Likely, MS Access updates multiple times for each join match rendering a cumulative sum update whereas SQL Server updates only once on the first instance of each join match.
Consider using a window function to stay at unit level and avoid the aggregate subquery:
UPDATE B
SET B.valB = B.valB + t.cum_sum
FROM B
INNER JOIN
(SELECT A.ID, SUM(A.valA) OVER(PARTITION BY A.id) AS cum_sum
FROM A
INNER JOIN B ON A.ID = B.ID) t
ON B.ID = t.ID;
Or with a CTE:
WITH CTE AS
(
SELECT A.ID, SUM(A.valA) OVER(PARTITION BY A.id) AS cum_sum
FROM A
INNER JOIN B ON A.ID = B.ID
)
UPDATE B
SET B.valB = B.valB + CTE.cum_sum
FROM B
INNER JOIN CTE
ON B.ID = CTE.ID;
Rextester Demo
I tried changing the order TSQL seems to use the first value. This is non-deterministic as a table is not supposed to have a natural order.
declare #a table (id int, val int)
insert into #a(id, val) VALUES (1, 2), (1, 1), (1, 3), (2, 1), (2, 2), (3, 0);
declare #b table (id int, val int);
insert into #b (id, val) VALUES (1, 0), (2, 0), (3, 0);
UPDATE b SET b.val = b.val + a.val
FROM #a a
INNER JOIN #b b
ON a.id = b.id
SELECT * FROM #b;
Not a lot of help you you could create views for sum and count to not repeat as much code.
The only solution I can found is:
create table A (id int, valA real)
insert into A(id, valA) VALUES (1, 1), (1, 2), (1, 3), (2, 1), (2, 2), (3, 0)
create table B (id int, valB real)
insert into B(id, valB) VALUES (1, 0), (2, 0), (3, 0)
UPDATE B SET B.valB += (SELECT SUM(valA) FROM A WHERE A.id=B.id)
select * from B
as Microsoft says here and there,
a single UPDATE statement never updates the same row two times.
With some limitations and assumptions this code work well with queries in my database
Public Function UpSizeUPDATEwithJOIN(tsqlText As String, Optional fMultiLineOutput As Boolean) As String
' transform TSQL UPDATE with JOINS and repeatable self assigments to UPDATE with CTE, GROUP BY and SUM
' test commands
'?UpSizeUPDATEwithJOIN("UPDATE B SET B.valB = B.valB + A.valA FROM A INNER JOIN B ON A.id = B.id ;",true)
'?UpSizeUPDATEwithJOIN("UPDATE vrtРезерв SET vrtРезерв.КвоВыдано = Round([vrtРезерв].[КвоВыдано]+[КомплектРез].[Кво],3.0), vrtРезерв.ДолгВыдать = vrtРезерв.ДолгВыдать - [КомплектДет].[Списано] FROM Комплект INNER JOIN ((vrtРезерв INNER JOIN КомплектРез ON (vrtРезерв.Код = КомплектРез.Код) AND (vrtРезерв.ВЭ = КомплектРез.ВЭ)) INNER JOIN КомплектДет ON (vrtРезерв.przDav = КомплектДет.przDav) AND (КомплектРез.КодКомплДет = КомплектДет.КодКомплДет)) ON (vrtРезерв.КодКор = Комплект.КодКор) AND (Комплект.КодКомпл = КомплектДет.КодКомпл) AND (Комплект.КодКомпл = КомплектРез.КодКомпл);",true)
Dim tmpSQL As String
Dim nameTargetTable As String
Dim enameTargetTable As String
Dim cLenTableEName As Long
Dim cLenTableName As Long
Dim strNL As String
If fMultiLineOutput Then
strNL = vbNewLine
End If
nameTargetTable = unWrapWith(Trim(GetInner(tsqlText, "UPDATE ", " SET")), "[", "]") ' table
enameTargetTable = wrapWith(nameTargetTable, "[", "]") ' [table]
cLenTableEName = Len(enameTargetTable)
cLenTableName = Len(nameTargetTable)
Dim tsqlFROMpart As String
Dim dictGROUPBYFields As Dictionary
tsqlFROMpart = GetInnerEx(tsqlText, "FROM ", "WHERE ", ";", """", "<EOL>")
Set dictGROUPBYFields = New Dictionary
dictGROUPBYFields.CompareMode = TextCompare ' means Table = TaBlE
Dim posAt As Long
Dim posStart As Long
Dim posEnd As Long
Dim strConditions As String
Dim arrConditions() As String
Dim strCurrCond As String
Dim strParts() As String
Dim i As Long
Dim j As Long
Dim nameField As String
Dim nameTable As String
Dim posTableNameSt As Long
Dim posTableNameEnd As Long
' join conditions start at ON
posAt = InStr(1, tsqlFROMpart, " ON ")
While posAt > 0
posStart = posAt + 4
' conditions last till JOIN or end of FROM part
posEnd = FirstAnyOf(tsqlFROMpart, posStart, " LEFT ## RIGHT ## INNER ## JOIN ## ON ", "##")
strConditions = Mid(tsqlFROMpart, posStart, posEnd - posStart + 1)
' conditions separated by AND or OR logical operators
strConditions = Replace(strConditions, " AND ", "##")
strConditions = Replace(strConditions, " OR ", "##")
arrConditions = Split(strConditions, "##")
For i = LBound(arrConditions) To UBound(arrConditions)
strCurrCond = arrConditions(i)
' condition can be made by = , < , > , <> , >= , <=
strCurrCond = Replace(strCurrCond, "=", "##")
strCurrCond = Replace(strCurrCond, ">", "##")
strCurrCond = Replace(strCurrCond, "<", "##")
strCurrCond = Replace(strCurrCond, "####", "##")
strCurrCond = unWrapWith(strCurrCond, "(", ")")
strParts = Split(strCurrCond, "##")
' target table can be on left side or right side
For j = 0 To 1
strParts(j) = Trim(strParts(j))
strParts(j) = Replace(strParts(j), "(", "") ' becase cutting
strParts(j) = Replace(strParts(j), ")", "") ' is not accurate
' name in this condition can be wrapped with [] or unwrapped
posTableNameSt = InStr(1, strParts(j), enameTargetTable)
If posTableNameSt <> 0 Then
posTableNameEnd = posTableNameSt + cLenTableEName
Else
posTableNameSt = InStr(1, strParts(j), nameTargetTable)
posTableNameEnd = posTableNameSt + cLenTableName
End If
If posTableNameSt > 0 Then
' found , so add to dictionary
nameField = Mid(strParts(j), posTableNameEnd + 1) ' +1 because of . between table name and field name
dictGROUPBYFields(nameField) = strParts(j)
Exit For
End If
Next j
Next i
posAt = InStr(posAt + 1, tsqlFROMpart, " ON ")
Wend
Dim tsqlSETpart As String
tsqlSETpart = GetInner(tsqlText, " SET ", " FROM ")
Dim arrSetExpressions() As String
Dim strCurrExpression As String
Dim strExprValue As String
Dim dictFieldsInExpressions As Dictionary
Dim posFieldNameEnd As Long
Dim dictTmp As Dictionary
Dim posEqualSign As Long
Dim strTmp As String
Dim tsqlNewSETpart As String
Set dictFieldsInExpressions = New Dictionary
dictFieldsInExpressions.CompareMode = TextCompare ' means Table.Fld = TaBlE.FlD
arrSetExpressions = SplitLineCall("SET " & tsqlSETpart)
For i = 1 To UBound(arrSetExpressions) ' skipped SET element
strCurrExpression = arrSetExpressions(i) ' whole part
posEqualSign = InStr(1, strCurrExpression, "=")
strExprValue = Trim(Mid(strCurrExpression, posEqualSign + 1))
' so look in expressions for table.field references and put them into dictionary if not from target table
posAt = InStr(1, strExprValue, ".")
While posAt > 0
' go right to find fields name
If Mid(strExprValue, posAt + 1, 1) = "[" Then
posFieldNameEnd = InStr(posAt + 2, strExprValue, "]")
Else
posFieldNameEnd = FirstAnyOf(strExprValue, posAt + 2, " #,#;#""#)#(#=#+#-#/#*")
End If
nameField = Mid(strExprValue, posAt + 1, posFieldNameEnd - posAt)
'go left to find table name
If Mid(strExprValue, posAt - 1, 1) = "]" Then
posTableNameSt = InStrRev(strExprValue, "[", posAt - 2)
Else
posTableNameSt = FirstAnyOfRev(strExprValue, posAt - 1, " #,#;#""#)#(#=#+#-#/#*") + 1
End If
nameTable = Mid(strExprValue, posTableNameSt, posAt - posTableNameSt)
' if we found not target table add to dictionary
If unWrapWith(nameTable, "[", "]") <> nameTargetTable Then
strTmp = Mid(strExprValue, posTableNameSt, posFieldNameEnd - posTableNameSt + 1)
If isEvaluationable(strTmp) Then
' do nothing it is just a number with point
Else
Set dictTmp = New Dictionary
dictTmp("nameTable") = nameTable
dictTmp("nameField") = nameField
dictTmp("expression") = strTmp
Set dictFieldsInExpressions(dictTmp("expression")) = dictTmp
Set dictTmp = Nothing
' and replace Table name to CTE
strExprValue = Left(strExprValue, posTableNameSt - 1) & "CTE" & Mid(strExprValue, posAt)
posAt = posAt + Len(nameTable) - 3
End If
End If
posAt = InStr(posAt + 1, strExprValue, ".")
Wend
strCurrExpression = Left(strCurrExpression, posEqualSign) & " " & strExprValue
arrSetExpressions(i) = strCurrExpression ' write back
tsqlNewSETpart = tsqlNewSETpart & " , " & strNL & strCurrExpression
Next i
tsqlNewSETpart = Mid(tsqlNewSETpart, 4 + Len(strNL))
Dim tsqlResult As String
Dim tsqlNewFROMpart As String ' 1
Dim tsqlNewONpart As String '7
Dim tsqlGROUPfields As String ' 2 & 6
Dim tsqlSUMfields As String
Dim tsqlWHEREpart As String
tsqlNewFROMpart = GetInner(tsqlText, " FROM ", ";", True)
tsqlWHEREpart = GetInnerEx(tsqlNewFROMpart, "WHERE ", "GROUP BY ", "HAVING ", "ORDER BY ", ";", "<EOL>")
If tsqlWHEREpart <> "" Then
tsqlWHEREpart = " WHERE " & tsqlWHEREpart
End If
tsqlGROUPfields = Join(dictGROUPBYFields.Items, " , ")
Dim varKey As Variant
Dim dictItem As Variant
For Each dictItem In dictFieldsInExpressions.Items
tsqlSUMfields = tsqlSUMfields & ", " & "SUM(" & dictItem("expression") & ") AS " & dictItem("nameField") & ""
Next dictItem
For Each varKey In dictGROUPBYFields.Keys
tsqlNewONpart = tsqlNewONpart & " AND " & "(" & enameTargetTable & "." & varKey & " = CTE." & varKey & ")"
Next varKey
tsqlNewONpart = Mid(tsqlNewONpart, 6)
tsqlResult = _
"WITH CTE AS (" & strNL & _
" SELECT " & strNL & _
" " & tsqlGROUPfields & strNL & _
" " & tsqlSUMfields & strNL & _
" FROM " & strNL & _
" " & tsqlNewFROMpart & strNL & _
" GROUP BY " & strNL & _
" " & tsqlGROUPfields & strNL & _
") " & strNL & _
"UPDATE " & strNL & _
" " & enameTargetTable & " " & strNL & _
"SET " & strNL & _
"" & tsqlNewSETpart & " " & strNL & _
"FROM " & strNL & _
" " & enameTargetTable & " " & strNL & _
" INNER JOIN " & strNL & _
" CTE " & strNL & _
" ON " & strNL & _
" " & tsqlNewONpart & strNL & _
"" & tsqlWHEREpart & strNL & _
";"
If Not fMultiLineOutput Then
tsqlResult = ReplaceAll(tsqlResult, " ", " ")
End If
Dim bIsResultValid As Boolean
'bIsResultValid = isValidTSQL(tsqlResult) ' check if we got goot TSQL
'If bIsResultValid Then
UpSizeUPDATEwithJOIN = """" & tsqlResult & """"
'Else
' UpSizeUPDATEwithJOIN = tsqlText
' Debug.Print , "!!U GOT bad: " & tsqlResult
'End If
End Function
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.
I have 2 tables, TableA and TableB. IMAT_PRIORITY_ID is primary key in TableA.
How can I get the value of IMAT_PRIORITY_ID in a textbox after inserting into TableA?
strSQL1 = "INSERT TableA (IMAT_PRIORITY_ID,JOB_NO,BATCH_NO) VALUES (SQ_PRIOTITY_ID.nextval," & JOB_NO.Text & "','" & BATCH_NO.Text & "')"
With adoCommand
.ActiveConnection = adoconn
.CommandType = adCmdText
.CommandText = strSQL1
.Prepared = True
.Execute , , adCmdText + adExecuteNoRecords
End With
strSQL1 = "INSERT TableB (ISBN_SERIAL_NO,IMAT_PRIORITY_ID,ISBN) VALUES (ISBN_SERIAL_NO.NEXTVAL,'" & IMAT_PRIORITY_ID.Text & "','" & ISBN.Text & "')"
With adoCommand
.ActiveConnection = adoconn
.CommandType = adCmdText
.CommandText = strSQL1
.Prepared = True
.Execute , , adCmdText + adExecuteNoRecords
End With
To get the last identity (PRIMARY KEY) generated from the insert statement you can query it as follows..
strSQL1 = "INSERT TableA (IMAT_PRIORITY_ID,JOB_NO,BATCH_NO) VALUES (SQ_PRIOTITY_ID,JOB_NO,BATCH_NO) VALUES (SQ_PRIOTITY_ID.nextval," & JOB_NO.Text & "','" & BATCH_NO.Text & "');SELECT SCOPE_IDENTITY()"
You can find more details over here