Question

我有以下代码用于下载测试用例。它没有下载任何东西，但当我已经连接时，这是有效的。 QC以HTML格式存储描述。所以在存储之前在Excel中，StripHTML()将删除所有HTML标记并放入仅限文本。新行标记<br>也会替换为新行 Excel中的字符chr(10)，以便正确显示所有新行文字：

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

Answer 1

试试这个，

在运行之前，请填写必填字段。在单元格C1中输入域名，在单元格C2中输入项目名称，在单元格C3中输入文件夹路径名称（例如，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

希望这会有所帮助......

此致阿斯温

从QC导入测试用例

1 个答案: