0

I have a VBA script written to query HP ALM database using OTA API.

I want to query the database using a Recursive CTE. I don't know how to write that script within this VBA script.

VBA Script:::

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 Query::::

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;
Community
  • 1
  • 1
Lokesh Sah
  • 2,283
  • 5
  • 23
  • 33
  • the scipt in VBA is the same as in SQL-Server. Just put the SQL-Statemen in a String-Variable and open a Recordset – CPMunich Nov 18 '15 at 12:50
  • Will it work for multiple statement query ? – Lokesh Sah Nov 18 '15 at 12:51
  • 1
    Yes it will. You'll need to use [`NextRecordset`](https://msdn.microsoft.com/en-us/library/ms677539%28v=vs.85%29.aspx) after you've read all the rows from one statement to start the rows from the next. – Richard Nov 18 '15 at 13:36

1 Answers1

1

Here is your code with your query embedded and your query variable declared as a VBA variable and referenced in the SQL script:

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

UPDATED to avoid injection

neuralgroove
  • 580
  • 4
  • 12
  • That's a SQL Injection Vulnerability: ***always*** use parameters. – Richard Nov 18 '15 at 13:34
  • There are three parts to why. Firstly always using parameters avoids needing to decide when you need to (and updating to parameters) when code is reused. Secondly as a script expands and is reused that value starts coming from a parameter…. Thirdly it means you do not need to think about quoting in strings or formatting of dates: it simplifies the code. – Richard Nov 18 '15 at 15:03
  • IMHO it is everyone's job to avoid developers seeing practice that has lead to many hacks succeeding (perhaps more than any other cause of vulnerabilities). – Richard Nov 18 '15 at 15:05
  • (My last two comments respond to now deleted comments. And I'll take back the down vote now this is fixed.) – Richard Nov 18 '15 at 15:06