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

问题

I am trying to find a way to automate uploading manual testcases in excel to ALM. I have been using the 'Export to HP ALM' Addin. However, This process is manual as you need to select the range and follow the wizard like steps of this Addin.

Is there anyway to use this Addin using Macro/vbscript ? or is there any way to use the same map name used in this addin through OTA ?

Update 1:

Found a way for the above question ( the answer is posted below ) However, I need to speed up the process i.e. decrease the time taken to upload. Any help on this ?

回答1:

Here you go :

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

来源：https://stackoverflow.com/questions/45814380/how-to-use-export-to-hp-alm-addin-for-excel-using-macro-or-vbscript