如何使用Macro或VbScript在Excel中使用“导出到HP ALM”加载项

Question

我正在尝试找到一种自动将excel中的手动测试用例自动上载到ALM的方法。 我一直在使用“ 导出到HP ALM ”加载项。 但是，当你需要选择范围，并按照这样的加载项的步骤向导这个过程是手动的。

无论如何，可以使用Macro / vbscript使用此Addin吗？ 还是有什么方法可以通过OTA使用此插件中使用的相同地图名称？

更新1：

找到了解决上述问题的方法（答案发布在下面），但是，我需要加快处理过程，即减少上载时间。 有什么帮助吗？

Answer 1

干得好 ：

Sub QCUpload()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Cell As Range
Dim sBook As String

        If Workbooks.Count < 2 Then
            MsgBox "Error: Only one Workbook is open" & vbCr & _
            "Open a 2nd Workbook and run this macro again."
            Exit Sub
        End If
    'target work book
        Set wb1 = ThisWorkbook
        For Each wb2 In Workbooks
            If wb2.Name <> wb1.Name Then Exit For
        Next
        MsgBox "1. - " & wb1.Name
        MsgBox "2. - " & wb2.Name
        FolderValue = wb1.Worksheets(1).Cells(11, 1)

     ' get the count of worksheet
        MsgBox "Total Worksheet in " & wb2.Name & " is " & wb2.Worksheets.Count

     ' Verify if the field names are correct
        For i = 1 To wb2.Worksheets.Count
            For J = 1 To wb2.Worksheets(i).UsedRange.Columns.Count - 1
                If Not wb2.Worksheets(i).Cells(1, J) = wb1.Worksheets(1).Cells(9, J) Then
                    MsgBox "Column Names are not proper"
                    Err = 1
                Exit For
                End If

            Next
            'Check for special characters
                nLR = wb2.Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Row
                For cw = 2 To 6
                    If wb1.Worksheets(1).Cells(8, cw) <> "" Then
                    RpVal = wb1.Worksheets(1).Cells(8, cw)

                wb2.Worksheets(i).Columns("C").Replace What:=RpVal, _
                        Replacement:="", _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        MatchCase:=False, _
                        SearchFormat:=False, _
                        ReplaceFormat:=False
                    End If
                Next
        Next


        'Check for any errors
        If Err = 1 Then
            MsgBox "There are error"
            Exit Sub
        End If


        'Connect to ALM
        Set TDConn = CreateObject("TDApiOle80.TDConnection")

        'QC Connection data

            login_id = wb1.Worksheets(1).Cells(3, 2).Value
            login_passwd = wb1.Worksheets(1).Cells(4, 2).Value
            domain_name = wb1.Worksheets(1).Cells(5, 2).Value
            project_name = wb1.Worksheets(1).Cells(6, 2).Value
            server_name = wb1.Worksheets(1).Cells(7, 2).Value

        TDConn.InitConnectionEx server_name
        TDConn.login login_id, login_passwd
        TDConn.Connect domain_name, project_name

        '' set root folder
            Set tsf = TDConn.TestFactory
            Set trmgr = TDConn.TreeManager
            Set subjectfldr = trmgr.NodebyPath("Subject")

        ' read the main and sub folder names

            Set subjectfldr = trmgr.NodebyPath(FolderValue)

            subjectfldr.Post
        '
        ' Iterate through all testcases on a sheet
        For i = 1 To wb2.Worksheets.Count
            LastRow = wb2.Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Row
            For CurrRow = 2 To LastRow
            'Test case no:
            If wb2.Worksheets(i).Cells(CurrRow, 2) <> "" Then
                TestCaseNo = wb2.Worksheets(i).Cells(CurrRow, 2)

            ' now create a test case
            Set MyTest = subjectfldr.TestFactory.AddItem(Null)

            ' set mandatory values
                MyTest.Field("TS_NAME") = wb2.Worksheets(i).Cells(CurrRow, 3)
                MyTest.Field("TS_USER_03") = wb2.Worksheets(i).Cells(CurrRow, 8) ' Complexity
                MyTest.Field("TS_TYPE") = wb2.Worksheets(i).Cells(CurrRow, 9) ' Functionality
                MyTest.Post

            ' create test steps
                Set dsf = MyTest.DesignStepFactory


                ' loop through all the steps

                For RowCount = CurrRow To LastRow
                If wb2.Worksheets(i).Cells(RowCount, 4) = "" Then
                    Exit For
                Else
                Set dstep = dsf.AddItem(Null)
                dstep.StepName = wb2.Worksheets(i).Cells(RowCount, 5)
                dstep.StepDescription = wb2.Worksheets(i).Cells(RowCount, 6)
                dstep.StepExpectedResult = wb2.Worksheets(i).Cells(RowCount, 7)
                dstep.Post
                End If
                Next
              End If
            Next
        Next

    'End Upload
    MsgBox "Upload Complete"

    ' Diconnect TD connection
    TDConn.Disconnect
    ' Log the user off the server
    TDConn.Logout
    'Release the TDConnection object.
    TDConn.ReleaseConnection
    ' Release the object
    Set TDConn = Nothing

End Sub