Import test cases from QC

Question

I have the following code for the download of the test cases. It does not download anything, but when I'm already connected, this works. QC stores description in HTML format. So before storing it in to Excel, StripHTML() will remove all HTML tags and put texts only. Also new line tag <br> is replaced with new line character chr(10) in Excel so that all the new line texts appears properly:

fpath = "Root\Regression"
Set myfilter = TstFactory.Filter()
myfilter.Filter("TS_SUBJECT") = "^" & fpath & "^"'Get a list of all test cases for your specified path
Set TestList = myfilter.NewList()
'Format the header before downloading the test cases
With ActiveSheet
    .Range("B5").Select
    With .Range("B4:H4")
        .Font.Name = "Arial"
        .Font.FontStyle = "Bold"
        .Font.Size = 10
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Interior.ColorIndex = 15
    End With
    .Cells(4, 2) = "Subject (Folder Name)"
    .Cells(4, 3) = "Test Name (Manual Test Plan Name)"
    .Cells(4, 4) = "Description"
    .Cells(4, 5) = "Status"
    .Cells(4, 6) = "Step Name"
    .Cells(4, 7) = "Step Description(Action)"
    .Cells(4, 8) = "Expected Result"
    Dim Row
    Row = 5 '- set the data row from 5
'loop through all the test cases.
    For Each TestCase In TestList
        .Cells(Row, 2).Value = TestCase.Field("TS_SUBJECT").Path
        .Cells(Row, 3).Value = TestCase.Field("TS_NAME")        
'QC stores description in html format. So before storing it
'in to excel, StripHTML() will remove all HTML tags and put
'texts only. Also new line tag <br> is replaced with new line
'character chr(10) in excel so that all the new line texts appears properly
        .Cells(Row, 4).Value = StripHTML(Replace(TestCase.Field("TS_DESCRIPTION"), _
   "<br>", Chr(10)))
        .Cells(Row, 5).Value = TestCase.Field("TS_EXEC_STATUS")
'Get the DesignStepFactory for the this testcase
        Dim DesignStepFactory, DesignStep, DesignStepList
        Set DesignStepFactory = TestCase.DesignStepFactory
        Set DesignStepList = DesignStepFactory.NewList("")
'Check if design steps exists for the test
        If DesignStepList.Count <> 0 Then
'loop for all the steps for this test case
            For Each DesignStep In DesignStepList
                .Cells(Row, 6).Value = DesignStep.StepName
                .Cells(Row, 7).Value =    StripHTML(Replace(DesignStep.StepDescription, _
 "<br>", Chr(10)))
                .Cells(Row, 8).Value = StripHTML(Replace(DesignStep.StepExpectedResult, _
 "<br>", Chr(10)))
                Row = Row + 1
            Next 'next Step
        End If
        ' release the design step objects
        Set DesignStepFactory = Nothing
        Set DesignStep = Nothing
        Set DesignStepList = Nothing
    Next ' Next test case
End With
'Release the object
Set DesignStepFactory = Nothing
Set DesignStep = Nothing
Set DesignStepList = Nothing
Set TstFactory = Nothing
Set TestList = Nothing
Set TestCase = Nothing
QCConnection.Disconnect
MsgBox ("All Test cases are downloaded with Test Steps")
End Sub
Function StripHTML(sInput As String) As String
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
Dim sInput As String
Dim sOut As String
sInput = cell.Text
With RegEx
    .Global = True
    .IgnoreCase = True
    .MultiLine = True
    .Pattern = "<[^>]+>" 'Regular Expression for HTML Tags.
End With
sOut = RegEx.Replace(sInput, "")
StripHTML = sOut
Set RegEx = Nothing
End Function

score 0 · Answer 1 · answered Apr 25 '16 at 12:20

Try This,

Before running this please fill the mandatory fields. Enter Domain name in Cell C1, Enter Project name in Cell C2 , Enter Folder Path name in Cell C3 (eg. Subject\Test_Folder1\Child_Folder1)

Sub EmportTestCases()
    On Error Resume Next
    Dim QCConnection
    Dim sUserName, sPassword
    Dim sDomain, sProject
    Dim TstFactory, TestList
    Dim TestCase
'Create QC Connection Object to connect to QC
    Set QCConnection = CreateObject("TDApiOle80.TDConnection")
    sUserName = "USerName"      '<-----------------change Me
    sPassword = "Password"   '<-----------------change Me  
    QCConnection.InitConnectionEx "http://<server_Name>:<port>/qcbin"  '<-----------------change Me
'Authenticate your user ID and Password
    QCConnection.Login sUserName, sPassword
'Quit if QC Authentication fails
    If (QCConnection.LoggedIn <> True) Then
        MsgBox "QC User Authentication Failed"
        End
    End If


    sDomain = Range("C1").Value             'Enter Domain name in Cell C1
    sProject = Range("C2").Value            'Enter Project name in Cell C2
    fpath = Range("C3").Value               'Enter Folder Path name in Cell C3

'Login to your Domain and Project
    QCConnection.Connect sDomain, sProject
'Quit if login fails to specified Domain and Project
    If (QCConnection.AuthenticationToken = "") Then
        MsgBox "QC Project Failed to Connect to " & sProject
        QCConnection.Disconnect
        End
    End If
'Now successful connection is made to QC
'Get the test factory
    Set TstFactory = QCConnection.TestFactory
' Your QC Project Path for which you want to download
' the test cases.
    Set myfilter = TstFactory.Filter()

    myfilter.Filter("TS_SUBJECT") = "^" & fpath & "^"

'Get a list of all test cases for your specified path
    Set TestList = myfilter.NewList()
'Format the header before downloading the test cases
    With ActiveSheet
        .Range("B5").Select
        With .Range("B4:I4")
            .Font.Name = "Arial"
            .Font.FontStyle = "Bold"
            .Font.Size = 10
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Interior.ColorIndex = 15
        End With
        .Cells(4, 2) = "Subject (Folder Name)"
        .Cells(4, 3) = "Test Name (Manual Test Plan Name)"
        .Cells(4, 4) = "Test Type"
        .Cells(4, 5) = "Description"
        .Cells(4, 6) = "Status"
        .Cells(4, 7) = "Step Name"
        .Cells(4, 8) = "Step Description(Action)"
        .Cells(4, 9) = "Expected Result"
        Dim Row
        Row = 5 '- set the data row from 5
'loop through all the test cases.
        For Each TestCase In TestList
            .Cells(Row, 2).Value = TestCase.Field("TS_SUBJECT").Path
            .Cells(Row, 3).Value = TestCase.Field("TS_NAME")
'QC stores description in html format. So before storing it
'in to excel, RemoveHTML() will remove all HTML tags and put
'texts only. Also new line tag <br> is replaced with new line
'character chr(10) in excel so that all the new line texts appears properly
            .Cells(Row, 4).Value = TestCase.Field("TS_TYPE")
            .Cells(Row, 5).Value = RemoveHTML(Replace(TestCase.Field("TS_DESCRIPTION"), "<br>", Chr(10)))
            .Cells(Row, 6).Value = TestCase.Field("TS_EXEC_STATUS")
'Get the DesignStepFactory for the this testcase
            Dim DesignStepFactory, DesignStep, DesignStepList
            Set DesignStepFactory = TestCase.DesignStepFactory
            Set DesignStepList = DesignStepFactory.NewList("")
'Check if design steps exists for the test
            If DesignStepList.Count <> 0 Then
'loop for all the steps for this test case
                For Each DesignStep In DesignStepList
                    .Cells(Row, 7).Value = DesignStep.Field("DS_STEP_NAME")
                    .Cells(Row, 8).Value = RemoveHTML(DesignStep.Field("DS_DESCRIPTION"))
                    .Cells(Row, 9).Value = RemoveHTML(DesignStep.Field("DS_EXPECTED"))
                    Row = Row + 1
                Next 'next Step
            End If
            ' release the design step objects
            Set DesignStepFactory = Nothing
            Set DesignStep = Nothing
            Set DesignStepList = Nothing
        Next ' Next test case
    End With
    'Release the object
    Set DesignStepFactory = Nothing
    Set DesignStep = Nothing
    Set DesignStepList = Nothing
    Set TstFactory = Nothing
    Set TestList = Nothing
    Set TestCase = Nothing
    QCConnection.Disconnect
    MsgBox ("All Test cases are downloaded with Test Steps")
End Sub

Function RemoveHTML(sInput As String) As String
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
'Dim sInput As String
Dim sOut As String
'sInput = cell.Text

    sInput = Replace(sInput, "\x0D\x0A", Chr(10))
    sInput = Replace(sInput, "\x00", Chr(10))


    sInput = Replace(sInput, "</P>", Chr(10) & Chr(10))
    sInput = Replace(sInput, "<BR>", Chr(10))
    sInput = Replace(sInput, "<li>", "-")

    sInput = Replace(sInput, "&ndash;", "Ð")
    sInput = Replace(sInput, "&mdash;", "Ñ")
    sInput = Replace(sInput, "&iexcl;", "Á")
    sInput = Replace(sInput, "&iquest;", "À")
    sInput = Replace(sInput, "&quot;", "")
    sInput = Replace(sInput, "&ldquo;", "Ò")
    sInput = Replace(sInput, "&rdquo;", "Ó")
    sInput = Replace(sInput, "", "'")
    sInput = Replace(sInput, "&lsquo;", "Ô")
    sInput = Replace(sInput, "&rsquo;", "Õ")
    sInput = Replace(sInput, "&laquo;", "Ç")
    sInput = Replace(sInput, "&raquo;", "È")
    sInput = Replace(sInput, "&nbsp;", "  ")
    sInput = Replace(sInput, "&amp;", "&")
    sInput = Replace(sInput, "&cent;", "¢")
    sInput = Replace(sInput, "&copy;", "©")
    sInput = Replace(sInput, "&divide;", "Ö")
    sInput = Replace(sInput, "&gt;", ">")
    sInput = Replace(sInput, "&lt;", "<")
    sInput = Replace(sInput, "&micro;", "µ")
    sInput = Replace(sInput, "&middot;", "á")
    sInput = Replace(sInput, "&para;", "¦")
    sInput = Replace(sInput, "&plusmn;", "±")
    sInput = Replace(sInput, "&euro;", "Û")
    sInput = Replace(sInput, "&pound;", "£")
    sInput = Replace(sInput, "&reg;", "¨")
    sInput = Replace(sInput, "&sect;", "¤")
    sInput = Replace(sInput, "&trade;", "ª")
    sInput = Replace(sInput, "&yen;", "´")
    sInput = Replace(sInput, "&aacute;", "‡")
    sInput = Replace(sInput, "&Aacute;", "ç")
    sInput = Replace(sInput, "&agrave;", "ˆ")
    sInput = Replace(sInput, "&Agrave;", "Ë")
    sInput = Replace(sInput, "&acirc;", "‰")
    sInput = Replace(sInput, "&Acirc;", "å")
    sInput = Replace(sInput, "&aring;", "Œ")
    sInput = Replace(sInput, "&Aring;", "")
    sInput = Replace(sInput, "&atilde;", "‹")
    sInput = Replace(sInput, "&Atilde;", "Ì")
    sInput = Replace(sInput, "&auml;", "Š")
    sInput = Replace(sInput, "&Auml;", "€")
    sInput = Replace(sInput, "&aelig;", "¾")
    sInput = Replace(sInput, "&AElig;", "®")
    sInput = Replace(sInput, "&ccedil;", "")
    sInput = Replace(sInput, "&Ccedil;", "‚")
    sInput = Replace(sInput, "&eacute;", "Ž")
    sInput = Replace(sInput, "&Eacute;", "ƒ")
    sInput = Replace(sInput, "&egrave;", "")
    sInput = Replace(sInput, "&Egrave;", "é")
    sInput = Replace(sInput, "&ecirc;", "")
    sInput = Replace(sInput, "&Ecirc;", "æ")
    sInput = Replace(sInput, "&euml;", "‘")
    sInput = Replace(sInput, "&Euml;", "è")
    sInput = Replace(sInput, "&iacute;", "’")
    sInput = Replace(sInput, "&Iacute;", "ê")
    sInput = Replace(sInput, "&igrave;", "“")
    sInput = Replace(sInput, "&Igrave;", "í")
    sInput = Replace(sInput, "&icirc;", "”")
    sInput = Replace(sInput, "&Icirc;", "ë")
    sInput = Replace(sInput, "&iuml;", "•")
    sInput = Replace(sInput, "&Iuml;", "ì")
    sInput = Replace(sInput, "&ntilde;", "–")
    sInput = Replace(sInput, "&Ntilde;", "„")
    sInput = Replace(sInput, "&oacute;", "—")
    sInput = Replace(sInput, "&Oacute;", "î")
    sInput = Replace(sInput, "&ograve;", "˜")
    sInput = Replace(sInput, "&Ograve;", "ñ")
    sInput = Replace(sInput, "&ocirc;", "™")
    sInput = Replace(sInput, "&Ocirc;", "ï")
    sInput = Replace(sInput, "&oslash;", "¿")
    sInput = Replace(sInput, "&Oslash;", "¯")
    sInput = Replace(sInput, "&otilde;", "›")
    sInput = Replace(sInput, "&Otilde;", "Í")
    sInput = Replace(sInput, "&ouml;", "š")
    sInput = Replace(sInput, "&Ouml;", "…")
    sInput = Replace(sInput, "&szlig;", "§")
    sInput = Replace(sInput, "&uacute;", "œ")
    sInput = Replace(sInput, "&Uacute;", "ò")
    sInput = Replace(sInput, "&ugrave;", "")
    sInput = Replace(sInput, "&Ugrave;", "ô")
    sInput = Replace(sInput, "&ucirc;", "ž")
    sInput = Replace(sInput, "&Ucirc;", "ó")
    sInput = Replace(sInput, "&uuml;", "Ÿ")
    sInput = Replace(sInput, "&Uuml;", "†")
    sInput = Replace(sInput, "&yuml;", "Ø")
    sInput = Replace(sInput, "", "«")
    sInput = Replace(sInput, "", "`")

With RegEx
   .Global = True
   .IgnoreCase = True
   .MultiLine = False
   .Pattern = "<[^>]+>" 'Regular Expression for HTML Tags.

End With
    sOut = RegEx.Replace(sInput, "")
    RemoveHTML = Replace(sOut, Chr(10), "")
    Set RegEx = Nothing

End Function

Hope this helps...

Regards, Ashwin

Import test cases from QC

1 Answers1