kdjonesmtb2
Technical User
I have a script in QTP an HP testing tool that can send temp table data to excel. I need to be able to incrementally add test case data from a datatable to an excel spreadsheet without overwriting the existing rows:
Here is the complete code the excel code is at the bottom
strConnection = "DRIVER=SQL Server;SERVER=csn-nhp-sql-08, 11001 ;UID=keithg;APP=QuickTest Professional;WSID=KEITHGJ790;DATABASE=plandata;Trusted_Connection=Yes"
Set connA = CreateObject("ADODB.Connection")
Set connB = CreateObject("ADODB.Connection")
connA.Open strConnection
connB.Open strConnection
Dim sqlFromQNXT, sqlFromHTrio, sqlFromHTrioTemplate, sSql, QNXT_referralid, QNXT_authorizationid, QNXT_servicecode, x
query ="select authorizationid,referralid, servicecode from referral where authorizationid = '" & DataTable.Value("HealthTrio_connect__AddOutput_Text_out",dtGlobalSheet) & "'"
Set rs = connA.Execute(query)
QNXT_authorizationid=""
if (not rs.eof) then 'check that we have at least one record
QNXT_authorizationid=trim(rs("authorizationid")) 'return the authorizationid field to a string variable
QNXT_referralid=trim(rs("referralid")) ' return the referralid
QNXT_servicecode=trim(rs("servicecode"))' return servicecode
end if
row=DataTable.GetCurrentRow
dt_authorization_id=trim(datatable("HealthTrio_connect__AddOutput_Text_out", dtGlobalSheet))
dt_test_casenumber=trim(datatable("Test_Case_Number",dtGlobalSheet))
query ="select diagcode " & _
" from authdiag " & _
" where referralid ='$REFERRALID$'" & _
"order by diagcode"'expecting multiple diagcodes… need to make sure these get returned in a consistent order
query = replace(query,"$REFERRALID$",QNXT_referralid)
print query
Set rs1 = connA.Execute(query)
varREFID ="RM000970377 "
sqlFromQNXT = "if (object_id('tempdb..#temp_in_qnxt') is not null) " & vbcrlf & _
"begin " & vbcrlf & _
"drop table #temp_in_qnxt " & vbcrlf & _
"end " & vbcrlf & _
" select iRow " & vbcrlf & _
" , comment " & vbcrlf & _
" , cd=max((case when iField=3 then splitdata else null end)) " & vbcrlf & _
" , qty=max((case when iField=4 then splitdata else null end)) " & vbcrlf & _
" into #temp_in_qnxt " & vbcrlf & _
" from ( " & vbcrlf & _
" select x1.* " & vbcrlf & _
" ,o.splitdata " & vbcrlf & _
" ,o.iField " & vbcrlf & _
" from ( " & vbcrlf & _
" select comment " & vbcrlf & _
" , xmlcomment= " & vbcrlf & _
" convert(xml, " & vbcrlf & _
" '<p>' + replace(comment,':','</p><p>') + '</p>' " & vbcrlf & _
" ) " & vbcrlf & _
" , iRow = row_number() over (order by (select 1)) " & vbcrlf & _
" from planaction(nolock) " & vbcrlf & _
" where primaryid ='$REFERRALID$' " & vbcrlf & _
" and source = 'HealthTrio Auth Referral' " & vbcrlf & _
" )X1 " & vbcrlf & _
" cross apply " & vbcrlf & _
" ( " & vbcrlf & _
" select xdata.p.value('.','varchar(50)') as splitdata " & vbcrlf & _
" ,iField=row_number() over (order by (select 1)) " & vbcrlf & _
" from X1.xmlcomment.nodes('p') as xdata(p) " & vbcrlf & _
" ) o " & vbcrlf & _
" ) vw " & vbcrlf & _
"group by iRow, Comment "
'sqlFromQNXT = replace(sqlFromQNXT,"$REFERRALID$",varRefID)
sqlFromQNXT = replace(sqlFromQNXT,"$REFERRALID$",QNXT_referralid) ' uncomment when code works for temp tables
'wscript.echo sqlFromQNXT
connB.Execute(sqlFromQNXT)
print sqlFromQNXT
sqlFromHTrio = "if (object_id('tempdb..#temp_in_htrio') is not null) " & vbcrlf & _
"begin " & vbcrlf & _
"drop table #temp_in_htrio " & vbcrlf & _
"end " & vbcrlf & _
"create table #temp_in_htrio " & vbcrlf & _
"( iRow int " & vbcrlf & _
" ,cd varchar(50) " & vbcrlf & _
" ,qty varchar(50)) "
'wscript.echo sqlfromhtrio
print sqlFromHTrio
connB.Execute(sqlFromHTrio)
print sqlFromHTrio
sqlFromHTrioTemplate = "insert into #temp_in_htrio (iRow, cd, qty) VALUES($ROW$, '$CD$', '$QTY$')"
Dim icheck3
Dim dt_cptbrmc
Dim dt_cptquantity
For icheck3 = 1 to 9
dt_cptbrmc=DataTable.Value("cptsearchtext" & cstr(icheck3),"Global")
dt_cptquantity=DataTable.Value("txt_procedure_quantity" & cstr(icheck3), "Global")
sqlFromHTrio = replace(replace(replace(sqlFromHTrioTemplate, "$ROW$", cstr(iCheck3)),"$CD$", dt_cptbrmc),"$QTY$",dt_cptquantity)
' wscript.echo sqlfromhtrio
print ("dt_cptbrmc")
print dt_cptbrmc
print ("dt_cptquantity")
print dt_cptquantity
print sqlFromHTrio
connB.Execute(sqlFromHTrio)
print sqlFromHTrio
Next
sSql = "select htrio_row=h.iRow "&vbcrlf & _
" , htrio_cd=h.cd " & vbcrlf & _
" , htrio_qty=h.qty " & vbcrlf & _
" , qnxt_row=q.irow " & vbcrlf & _
" , qnxt_cd= q.cd " & vbcrlf & _
" , qnxt_qty=q.qty " & vbcrlf & _
" , stat=case when h.cd is null then 'in qnxt missing in htrio' " & vbcrlf & _
" when q.cd is null then 'in htrio missing in qnxt' " & vbcrlf & _
" when q.qty<>h.qty then 'quantity discrepant' " & vbcrlf & _
" else 'OK' end " & vbcrlf & _
" into #cpt_variance " & vbcrlf & _
" from #temp_in_htrio h " & vbcrlf & _
" full outer join #temp_in_qnxt q " & vbcrlf & _
" on h.cd=q.cd "
'wscript.echo sSQL
connB.Execute(sSQL)
query = "select htrio_row=h.iRow "&vbcrlf & _
" , htrio_cd=h.cd " & vbcrlf & _
" , htrio_qty=h.qty " & vbcrlf & _
" , qnxt_row=q.irow " & vbcrlf & _
" , qnxt_cd= q.cd " & vbcrlf & _
" , qnxt_qty=q.qty " & vbcrlf & _
" , stat=case when h.cd is null then 'in qnxt missing in htrio' " & vbcrlf & _
" when q.cd is null then 'in htrio missing in qnxt' " & vbcrlf & _
" when q.qty<>h.qty then 'quantity discrepant' " & vbcrlf & _
" else 'OK' end " & vbcrlf & _
" into #cpt_variance " & vbcrlf & _
" from #temp_in_htrio h " & vbcrlf & _
" full outer join #temp_in_qnxt q " & vbcrlf & _
" on h.cd=q.cd "
Dim htrio_cd
Dim htrio_qty
Dim qnxt_cd
Dim qnxt_qty
'
'For icheck4 = 1 to 9
' htrio_cd =
'
'
' sqlFromHTrio = replace(replace(replace(sqlFromHTrioTemplate, "$ROW$", cstr(iCheck3)),"$CD$", dt_cptbrmc),"$QTY$",dt_cptquantity)
' ' wscript.echo sqlfromhtrio
'
' print ("dt_cptbrmc")
' print dt_cptbrmc
' print ("dt_cptquantity")
' print dt_cptquantity
'print sqlFromHTrio
' conn.Execute(sqlFromHTrio)
'print sqlFromHTrio
'Next
'
'
'While not rs(sSQL).eof
'
' 'comparison logic here
'
'
'
' rs(sSQL).movenext
'Wend
set rs602 = connB.execute("select * from #cpt_variance")
query = replace(query,"$TestCaseNumber$",dt_test_casenumber)
if not rs602.eof then
set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("J:\Health Trio\Query Repository\CPT_variance.xlsx")
Set xlWs = xlWb.Worksheets("Sheet1")
' Display Excel and give user control of Excel's lifetime
xlApp.Visible = False
xlApp.UserControl = True
' Copy field names to the first row of the worksheet
fldCount = rs602.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rs602.Fields(iCol - 1).Name
xlWs.Cells(2, iCol).Value = fldCount
Next
recArray = rs602.GetRows(-1)
recCount = UBound(recArray, 2) + 1
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = TransposeDim(recArray)
'xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = xlApp.WorksheetFunction.Transpose(recArray)
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
xlApp.visible = true
xlWb.close true
xlApp.Quit
else
msgbox "empty"
end if
'rs30.close
'set rs30 =nothing
'
'conn.close
'set conn = nothing
Function TransposeDim(v)
'Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
'Dim tempArray As Variant
Xupper = UBound(v, 2)
Yupper = UBound(v, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = v(Y, X)
Next
Next
TransposeDim = tempArray
End Function
Here is the complete code the excel code is at the bottom
strConnection = "DRIVER=SQL Server;SERVER=csn-nhp-sql-08, 11001 ;UID=keithg;APP=QuickTest Professional;WSID=KEITHGJ790;DATABASE=plandata;Trusted_Connection=Yes"
Set connA = CreateObject("ADODB.Connection")
Set connB = CreateObject("ADODB.Connection")
connA.Open strConnection
connB.Open strConnection
Dim sqlFromQNXT, sqlFromHTrio, sqlFromHTrioTemplate, sSql, QNXT_referralid, QNXT_authorizationid, QNXT_servicecode, x
query ="select authorizationid,referralid, servicecode from referral where authorizationid = '" & DataTable.Value("HealthTrio_connect__AddOutput_Text_out",dtGlobalSheet) & "'"
Set rs = connA.Execute(query)
QNXT_authorizationid=""
if (not rs.eof) then 'check that we have at least one record
QNXT_authorizationid=trim(rs("authorizationid")) 'return the authorizationid field to a string variable
QNXT_referralid=trim(rs("referralid")) ' return the referralid
QNXT_servicecode=trim(rs("servicecode"))' return servicecode
end if
row=DataTable.GetCurrentRow
dt_authorization_id=trim(datatable("HealthTrio_connect__AddOutput_Text_out", dtGlobalSheet))
dt_test_casenumber=trim(datatable("Test_Case_Number",dtGlobalSheet))
query ="select diagcode " & _
" from authdiag " & _
" where referralid ='$REFERRALID$'" & _
"order by diagcode"'expecting multiple diagcodes… need to make sure these get returned in a consistent order
query = replace(query,"$REFERRALID$",QNXT_referralid)
print query
Set rs1 = connA.Execute(query)
varREFID ="RM000970377 "
sqlFromQNXT = "if (object_id('tempdb..#temp_in_qnxt') is not null) " & vbcrlf & _
"begin " & vbcrlf & _
"drop table #temp_in_qnxt " & vbcrlf & _
"end " & vbcrlf & _
" select iRow " & vbcrlf & _
" , comment " & vbcrlf & _
" , cd=max((case when iField=3 then splitdata else null end)) " & vbcrlf & _
" , qty=max((case when iField=4 then splitdata else null end)) " & vbcrlf & _
" into #temp_in_qnxt " & vbcrlf & _
" from ( " & vbcrlf & _
" select x1.* " & vbcrlf & _
" ,o.splitdata " & vbcrlf & _
" ,o.iField " & vbcrlf & _
" from ( " & vbcrlf & _
" select comment " & vbcrlf & _
" , xmlcomment= " & vbcrlf & _
" convert(xml, " & vbcrlf & _
" '<p>' + replace(comment,':','</p><p>') + '</p>' " & vbcrlf & _
" ) " & vbcrlf & _
" , iRow = row_number() over (order by (select 1)) " & vbcrlf & _
" from planaction(nolock) " & vbcrlf & _
" where primaryid ='$REFERRALID$' " & vbcrlf & _
" and source = 'HealthTrio Auth Referral' " & vbcrlf & _
" )X1 " & vbcrlf & _
" cross apply " & vbcrlf & _
" ( " & vbcrlf & _
" select xdata.p.value('.','varchar(50)') as splitdata " & vbcrlf & _
" ,iField=row_number() over (order by (select 1)) " & vbcrlf & _
" from X1.xmlcomment.nodes('p') as xdata(p) " & vbcrlf & _
" ) o " & vbcrlf & _
" ) vw " & vbcrlf & _
"group by iRow, Comment "
'sqlFromQNXT = replace(sqlFromQNXT,"$REFERRALID$",varRefID)
sqlFromQNXT = replace(sqlFromQNXT,"$REFERRALID$",QNXT_referralid) ' uncomment when code works for temp tables
'wscript.echo sqlFromQNXT
connB.Execute(sqlFromQNXT)
print sqlFromQNXT
sqlFromHTrio = "if (object_id('tempdb..#temp_in_htrio') is not null) " & vbcrlf & _
"begin " & vbcrlf & _
"drop table #temp_in_htrio " & vbcrlf & _
"end " & vbcrlf & _
"create table #temp_in_htrio " & vbcrlf & _
"( iRow int " & vbcrlf & _
" ,cd varchar(50) " & vbcrlf & _
" ,qty varchar(50)) "
'wscript.echo sqlfromhtrio
print sqlFromHTrio
connB.Execute(sqlFromHTrio)
print sqlFromHTrio
sqlFromHTrioTemplate = "insert into #temp_in_htrio (iRow, cd, qty) VALUES($ROW$, '$CD$', '$QTY$')"
Dim icheck3
Dim dt_cptbrmc
Dim dt_cptquantity
For icheck3 = 1 to 9
dt_cptbrmc=DataTable.Value("cptsearchtext" & cstr(icheck3),"Global")
dt_cptquantity=DataTable.Value("txt_procedure_quantity" & cstr(icheck3), "Global")
sqlFromHTrio = replace(replace(replace(sqlFromHTrioTemplate, "$ROW$", cstr(iCheck3)),"$CD$", dt_cptbrmc),"$QTY$",dt_cptquantity)
' wscript.echo sqlfromhtrio
print ("dt_cptbrmc")
print dt_cptbrmc
print ("dt_cptquantity")
print dt_cptquantity
print sqlFromHTrio
connB.Execute(sqlFromHTrio)
print sqlFromHTrio
Next
sSql = "select htrio_row=h.iRow "&vbcrlf & _
" , htrio_cd=h.cd " & vbcrlf & _
" , htrio_qty=h.qty " & vbcrlf & _
" , qnxt_row=q.irow " & vbcrlf & _
" , qnxt_cd= q.cd " & vbcrlf & _
" , qnxt_qty=q.qty " & vbcrlf & _
" , stat=case when h.cd is null then 'in qnxt missing in htrio' " & vbcrlf & _
" when q.cd is null then 'in htrio missing in qnxt' " & vbcrlf & _
" when q.qty<>h.qty then 'quantity discrepant' " & vbcrlf & _
" else 'OK' end " & vbcrlf & _
" into #cpt_variance " & vbcrlf & _
" from #temp_in_htrio h " & vbcrlf & _
" full outer join #temp_in_qnxt q " & vbcrlf & _
" on h.cd=q.cd "
'wscript.echo sSQL
connB.Execute(sSQL)
query = "select htrio_row=h.iRow "&vbcrlf & _
" , htrio_cd=h.cd " & vbcrlf & _
" , htrio_qty=h.qty " & vbcrlf & _
" , qnxt_row=q.irow " & vbcrlf & _
" , qnxt_cd= q.cd " & vbcrlf & _
" , qnxt_qty=q.qty " & vbcrlf & _
" , stat=case when h.cd is null then 'in qnxt missing in htrio' " & vbcrlf & _
" when q.cd is null then 'in htrio missing in qnxt' " & vbcrlf & _
" when q.qty<>h.qty then 'quantity discrepant' " & vbcrlf & _
" else 'OK' end " & vbcrlf & _
" into #cpt_variance " & vbcrlf & _
" from #temp_in_htrio h " & vbcrlf & _
" full outer join #temp_in_qnxt q " & vbcrlf & _
" on h.cd=q.cd "
Dim htrio_cd
Dim htrio_qty
Dim qnxt_cd
Dim qnxt_qty
'
'For icheck4 = 1 to 9
' htrio_cd =
'
'
' sqlFromHTrio = replace(replace(replace(sqlFromHTrioTemplate, "$ROW$", cstr(iCheck3)),"$CD$", dt_cptbrmc),"$QTY$",dt_cptquantity)
' ' wscript.echo sqlfromhtrio
'
' print ("dt_cptbrmc")
' print dt_cptbrmc
' print ("dt_cptquantity")
' print dt_cptquantity
'print sqlFromHTrio
' conn.Execute(sqlFromHTrio)
'print sqlFromHTrio
'Next
'
'
'While not rs(sSQL).eof
'
' 'comparison logic here
'
'
'
' rs(sSQL).movenext
'Wend
set rs602 = connB.execute("select * from #cpt_variance")
query = replace(query,"$TestCaseNumber$",dt_test_casenumber)
if not rs602.eof then
set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("J:\Health Trio\Query Repository\CPT_variance.xlsx")
Set xlWs = xlWb.Worksheets("Sheet1")
' Display Excel and give user control of Excel's lifetime
xlApp.Visible = False
xlApp.UserControl = True
' Copy field names to the first row of the worksheet
fldCount = rs602.Fields.Count
For iCol = 1 To fldCount
xlWs.Cells(1, iCol).Value = rs602.Fields(iCol - 1).Name
xlWs.Cells(2, iCol).Value = fldCount
Next
recArray = rs602.GetRows(-1)
recCount = UBound(recArray, 2) + 1
xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = TransposeDim(recArray)
'xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = xlApp.WorksheetFunction.Transpose(recArray)
xlApp.Selection.CurrentRegion.Columns.AutoFit
xlApp.Selection.CurrentRegion.Rows.AutoFit
xlApp.visible = true
xlWb.close true
xlApp.Quit
else
msgbox "empty"
end if
'rs30.close
'set rs30 =nothing
'
'conn.close
'set conn = nothing
Function TransposeDim(v)
'Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
'Dim tempArray As Variant
Xupper = UBound(v, 2)
Yupper = UBound(v, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = v(Y, X)
Next
Next
TransposeDim = tempArray
End Function