如何使用宏或 VbScript 为 Excel 使用 'Export to HP ALM' 插件

How to use 'Export to HP ALM' Addin for Excel using Macro or VbScript

我正在尝试找到一种方法来自动将 excel 中的手动测试用例上传到 ALM。我一直在使用“Export to HP ALM”插件。但是,此过程是手动的,因为您需要 select 范围并遵循此插件的 向导 步骤。

是否可以通过 Macro/vbscript 使用此插件?或者有什么方法可以通过 OTA 使用此插件中使用的相同地图名称?

更新 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