如何在excel宏中传递ALM / QC测试计划文件夹路径以获取特定文件夹中脚本的步骤

时间:2015-10-13 17:20:10

标签: excel vba excel-vba

我有一个excel宏来获取ALM / QC测试计划中脚本的步骤。现在,它正在为所有脚本提取步骤,大约需要5-6个小时。我想为特定文件夹中的脚本获取步骤。我在如何传递文件夹路径方面遇到了麻烦。

请求帮助我如何传递文件夹路径。此外,如果可能,建议如何仅为特定脚本获取步骤。

我尝试了两种方法来提供文件夹路径。两者都没有用。

方式1:fpath ="主题/第1版/系统测试/ SCR 12345入站"

方式2:fpath =" ^&#92Subject&#92Release 1&#92System Test&#92SCR 12345 Inbound#92 ^"

下面是宏代码:

Function 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 = InputBox(Prompt:="Enter ALM username", Title:="ENTER ALM USERNAME", Default:="")

    sUserName = "username"
    sPassword = "xxxxxxx"

'   sPassword = InputBox(Prompt:="Enter Password", Title:="ENTER PASSWORD", Default:="")

    QCConnection.InitConnectionEx "QC url till QCBIN"
'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 = "PROJDOMAIN"
    sProject = "PROJ"
'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.
    fpath = InputBox(Prompt:="Enter Folder path", Title:="ENTER FOLDER PATH", Default:="")
'    fpath = "Subject/Release 1/System Test/SCR 12345  Inbound"
' Entered the above fpath for the folder path.

    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
           .Width = 20
       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, 4).Value = TestCase.Field("TS_DESCRIPTION")
            .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, 7).Value = DesignStep.StepDescription


                    .Cells(Row, 8).Value = StripHTML(Replace(DesignStep.StepExpectedResult, _
 "<br>", Chr(10)))
  '                  .Cells(Row, 8).Value = DesignStep.StepExpectedResult
                    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 Function

 Function StripHTML(sInput As String) As String
 Dim RegEx As Object
 Set RegEx = CreateObject("vbscript.regexp")

 Dim sOut As String
 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

强文

1 个答案:

答案 0 :(得分:0)

QC过滤器中的文件夹路径使用反斜杠...尝试反斜杠()。