如何使用 Macro 或 VbScript 的 Excel 版"导出到 HP ALM"插件

Question

我正在尝试找到一种方法来自动将 excel 中的手动测试用例上传到 ALM。我一直在使用">导出到 HP ALM"插件。但是，此过程是手动的，因为您需要选择范围并按照此插件的向导步骤进行操作。

有没有办法使用宏/vbscript 来使用这个插件？ 或者有没有办法通过 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