如何在 VBA 脚本中编写 CTE 递归查询?
How to write a CTE Recursive Query in VBA script?
我编写了一个 VBA 脚本来使用 OTA API 查询 HP ALM 数据库。
我想使用递归 CTE 查询数据库。我不知道如何在此 VBA 脚本中编写该脚本。
VBA 脚本:::
Sub Extractor()
Const QCADDRESS = "http://alm/qcbin"
Const DOMAIN = "DOMAIN"
Const PROJECT = "PROJECT"
Const QCUSR = "user.name"
Const QCPWD = "123456"
Dim QCConnection, com, recset
Dim XLS, Wkb, Wks, i
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
QCConnection.InitConnectionEx QCADDRESS
QCConnection.Login QCUSR, QCPWD
QCConnection.Connect DOMAIN, PROJECT
Set com = QCConnection.Command
com.CommandText = "Select * from ALL_LISTS"
Set recset = com.Execute
Set XLS = CreateObject("Excel.Application")
XLS.Visible = False
Set Wkb = XLS.Workbooks.Add
Set Wks = Wkb.Worksheets(1)
i = 1
Wks.Cells(i, 1).Value = "Data"
If recset.RecordCount > 0 Then
i = 2
recset.First
Do While Not (recset.EOR)
Wks.Cells(i, 1).Value = recset.FieldValue(0) 'fieldvalue(0) because the query extract only 1 field.
i = i + 1
recset.Next
Loop
Wkb.SaveAs "C:\myfile.xls"
End If
Wkb.Close
XLS.Quit
QCConnection.Disconnect
Set recset = Nothing
Set com = Nothing
Set QCConnection = Nothing
Set XLS = Nothing
Set Wkb = Nothing
Set Wks = Nothing
End Sub
CTE 查询::::
with ReqCTE
as
(
SELECT
RQ_REQ_ID,
RQ_REQ_NAME,
RQ_FATHER_ID,
0 as lvl
FROM
td.REQ
where
RQ_REQ_ID = {?Father_ID}
union all
select
Folders.RQ_REQ_ID,
Folders.RQ_REQ_NAME,
Folders.RQ_FATHER_ID,
Child.lvl +1
from
ReqCTE as Child
join td.REQ as Folders on Folders.RQ_REQ_ID = Child.RQ_FATHER_ID
);
select * from ReqCTE;
这是您的代码,其中嵌入了您的查询,您的查询变量声明为 VBA 变量并在 SQL 脚本中引用:
Sub Extractor()
Const QCADDRESS = "http://alm/qcbin"
Const DOMAIN = "DOMAIN"
Const PROJECT = "PROJECT"
Const QCUSR = "user.name"
Const QCPWD = "123456"
Dim par(0) As Variant
Dim QCConnection, com, recset
Dim XLS, Wkb, Wks, i
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
QCConnection.InitConnectionEx QCADDRESS
QCConnection.Login QCUSR, QCPWD
QCConnection.Connect DOMAIN, PROJECT
Set com = QCConnection.Command
par(0) = 4 'set parameter value for Father_ID in SQL
com.CommandText = "with ReqCTE as (" & _
"SELECT RQ_REQ_ID, RQ_REQ_NAME, RQ_FATHER_ID, 0 as lvl FROM td.REQ " & _
"where RQ_REQ_ID = ? " & _
"Union all " & _
"select Folders.RQ_REQ_ID, Folders.RQ_REQ_NAME, Folders.RQ_FATHER_ID, Child.lvl +1 from ReqCTE as Child " & _
"join td.REQ as Folders on Folders.RQ_REQ_ID = Child.RQ_FATHER_ID); " & _
"select * from ReqCTE;"
Set recset = com.Execute(, par)
Set XLS = CreateObject("Excel.Application")
XLS.Visible = False
Set Wkb = XLS.Workbooks.Add
Set Wks = Wkb.Worksheets(1)
i = 1
Wks.Cells(i, 1).Value = "Data"
If recset.RecordCount > 0 Then
i = 2
recset.First
Do While Not (recset.EOR)
Wks.Cells(i, 1).Value = recset.FieldValue(0) 'fieldvalue(0) because the query extract only 1 field.
i = i + 1
recset.Next
Loop
Wkb.SaveAs "C:\myfile.xls"
End If
Wkb.Close
XLS.Quit
QCConnection.Disconnect
Set recset = Nothing
Set com = Nothing
Set QCConnection = Nothing
Set XLS = Nothing
Set Wkb = Nothing
Set Wks = Nothing
End Sub
已更新以避免注入
我编写了一个 VBA 脚本来使用 OTA API 查询 HP ALM 数据库。
我想使用递归 CTE 查询数据库。我不知道如何在此 VBA 脚本中编写该脚本。
VBA 脚本:::
Sub Extractor()
Const QCADDRESS = "http://alm/qcbin"
Const DOMAIN = "DOMAIN"
Const PROJECT = "PROJECT"
Const QCUSR = "user.name"
Const QCPWD = "123456"
Dim QCConnection, com, recset
Dim XLS, Wkb, Wks, i
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
QCConnection.InitConnectionEx QCADDRESS
QCConnection.Login QCUSR, QCPWD
QCConnection.Connect DOMAIN, PROJECT
Set com = QCConnection.Command
com.CommandText = "Select * from ALL_LISTS"
Set recset = com.Execute
Set XLS = CreateObject("Excel.Application")
XLS.Visible = False
Set Wkb = XLS.Workbooks.Add
Set Wks = Wkb.Worksheets(1)
i = 1
Wks.Cells(i, 1).Value = "Data"
If recset.RecordCount > 0 Then
i = 2
recset.First
Do While Not (recset.EOR)
Wks.Cells(i, 1).Value = recset.FieldValue(0) 'fieldvalue(0) because the query extract only 1 field.
i = i + 1
recset.Next
Loop
Wkb.SaveAs "C:\myfile.xls"
End If
Wkb.Close
XLS.Quit
QCConnection.Disconnect
Set recset = Nothing
Set com = Nothing
Set QCConnection = Nothing
Set XLS = Nothing
Set Wkb = Nothing
Set Wks = Nothing
End Sub
CTE 查询::::
with ReqCTE
as
(
SELECT
RQ_REQ_ID,
RQ_REQ_NAME,
RQ_FATHER_ID,
0 as lvl
FROM
td.REQ
where
RQ_REQ_ID = {?Father_ID}
union all
select
Folders.RQ_REQ_ID,
Folders.RQ_REQ_NAME,
Folders.RQ_FATHER_ID,
Child.lvl +1
from
ReqCTE as Child
join td.REQ as Folders on Folders.RQ_REQ_ID = Child.RQ_FATHER_ID
);
select * from ReqCTE;
这是您的代码,其中嵌入了您的查询,您的查询变量声明为 VBA 变量并在 SQL 脚本中引用:
Sub Extractor()
Const QCADDRESS = "http://alm/qcbin"
Const DOMAIN = "DOMAIN"
Const PROJECT = "PROJECT"
Const QCUSR = "user.name"
Const QCPWD = "123456"
Dim par(0) As Variant
Dim QCConnection, com, recset
Dim XLS, Wkb, Wks, i
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
QCConnection.InitConnectionEx QCADDRESS
QCConnection.Login QCUSR, QCPWD
QCConnection.Connect DOMAIN, PROJECT
Set com = QCConnection.Command
par(0) = 4 'set parameter value for Father_ID in SQL
com.CommandText = "with ReqCTE as (" & _
"SELECT RQ_REQ_ID, RQ_REQ_NAME, RQ_FATHER_ID, 0 as lvl FROM td.REQ " & _
"where RQ_REQ_ID = ? " & _
"Union all " & _
"select Folders.RQ_REQ_ID, Folders.RQ_REQ_NAME, Folders.RQ_FATHER_ID, Child.lvl +1 from ReqCTE as Child " & _
"join td.REQ as Folders on Folders.RQ_REQ_ID = Child.RQ_FATHER_ID); " & _
"select * from ReqCTE;"
Set recset = com.Execute(, par)
Set XLS = CreateObject("Excel.Application")
XLS.Visible = False
Set Wkb = XLS.Workbooks.Add
Set Wks = Wkb.Worksheets(1)
i = 1
Wks.Cells(i, 1).Value = "Data"
If recset.RecordCount > 0 Then
i = 2
recset.First
Do While Not (recset.EOR)
Wks.Cells(i, 1).Value = recset.FieldValue(0) 'fieldvalue(0) because the query extract only 1 field.
i = i + 1
recset.Next
Loop
Wkb.SaveAs "C:\myfile.xls"
End If
Wkb.Close
XLS.Quit
QCConnection.Disconnect
Set recset = Nothing
Set com = Nothing
Set QCConnection = Nothing
Set XLS = Nothing
Set Wkb = Nothing
Set Wks = Nothing
End Sub
已更新以避免注入