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

Question

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 ie decrease the time taken to upload. Any help on this ?

Answer 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