不能将多个测试用例上传到HP ALM

Question

我的问题是，当前代码仅上载一个测试用例，并且由于测试步骤的数量是动态的，因此我无法添加多个测试用例（请参见附图），因此我不知道每个测试在哪一行如果我要说10个要上传的测试用例，则将用例添加到代码中以使整个过程自动化。

感谢您的帮助，提出了一种创建循环的方法，该循环可以集成所有内容，并让用户根据需要上传尽可能多的测试用例。

干杯。

我设法上传了一个包含所有步骤和预期结果的测试用例。

Sub upload_test_cases()

Dim wd, CConnection, sProject, sTestPlanPath, TestFolderPath, strNodeByPath

'qcURL = InputBox("Please enter ALM URL", "", "http://url:8080/qcbin")
qcURL = "http://url:8080/qcbin/"
If qcURL = "" Then
  MsgBox ("ALM URL cannot be blank")
  Exit Sub
End If

'sDomain = InputBox("Please enter your Domain" & vbNewLine & "Eg:CORE_SYSTEMS", "", "CORE_SYSTEMS")
sDomain = ""
If sDomain = "" Then
  MsgBox ("DomainName cannot be blank")
  Exit Sub
End If

'sProject = InputBox("Please enter your ProjectName" & vbNewLine & "Eg:RADC;GCM(As per ALM Project)", "", "GCM")
sProject = ""
If sProject = "" Then
  MsgBox ("ProjectName cannot be blank")
  Exit Sub
End If

sUser = InputBox("Please enter your Username" & vbNewLine & "Eg:MSID", "", "")
'sUser = ""
If sUser = "" Then
  MsgBox ("UserName cannot be blank")
  Exit Sub
End If

sPass = InputBox("Please enter your Password", "", "")
'sPass = ""

'sFolderpath = InputBox("Please enter your ALM Folderpath" & vbNewLine & "<Subject\FolderStructure>", "")
'sFolderpath = "Subject\Folder_Name"

'If sFolderpath = "" Then
 ' MsgBox ("FolderPath cannot be blank")
  'Exit Sub
'End If

Set QCConnection = CreateObject("TDApiOle80.TDConnection")

QCConnection.InitConnectionEx qcURL
QCConnection.ConnectProjectEx sDomain, sProject, sUser, sPass


Set tsf = QCConnection.TestFactory
Set trmgr = QCConnection.TreeManager
Set subjectfldr = trmgr.NodebyPath("Subject")
Worksheets("Sheet1").Select
' read the main and sub folder names
Set folder = Worksheets("Sheet1").Cells(2, 1)
Set subfolder = Worksheets("Sheet1").Cells(2, 2)

On Error Resume Next
' create main folder
Set trfolder = subjectfldr.AddNode(Worksheets("Sheet1").Cells(2, 1))
trfolder.Post

Set subjectfldr = trmgr.NodebyPath("Subject\" & folder)
'create subfolder if specified
If Not subfolder = "" Then
Set trfolder = subjectfldr.AddNode(subfolder)
trfolder.Post
End If

'reset error handling
On Error GoTo 0

If subfolder = "" Then
Set trfolder = trmgr.NodebyPath("Subject\" & folder)
Else
Set trfolder = trmgr.NodebyPath("Subject\" & folder & "\" & subfolder)
End If


' now create a test case
Set sampleTest = trfolder.TestFactory.AddItem(Null)
' set mandatory values
sampleTest.Field("TS_NAME") = Worksheets("Sheet1").Cells(2, 3) ' Test Case Name
sampleTest.Field("TS_DESCRIPTION") = Worksheets("Sheet1").Cells(2, 4) ' Project
sampleTest.Field("TS_RESPONSIBLE") = Worksheets("Sheet1").Cells(2, 8) ' Designer[![enter image description here][1]][1]


sampleTest.Post
' create test steps
Set dsf = sampleTest.DesignStepFactory
Set stepList = dsf.Newlist("[empty]")

Dim RowCount As Integer

' loop through all the steps
LastRow = Range("F2", Range("F2").End(xlDown)).Rows.Count
For i = 2 To (LastRow + 1)
Set dstep = dsf.AddItem(Null)
dstep.StepName = Worksheets("Sheet1").Cells(i, 5) ' Step Name
dstep.StepDescription = Worksheets("Sheet1").Cells(i, 6) ' Step Description
dstep.StepExpectedResult = Worksheets("Sheet1").Cells(i, 7) ' Step Expected Results
'stepList.Add (dstep)
'sampleTest.Post
dstep.Post
Next i


Set DesignStepFactory = Nothing
Set TestFactory = Nothing
Set TreeManager = Nothing

'Disconnect from QC
QCConnection.Disconnect

'Logout the QC Session
QCConnection.Logout
QCConnection.ReleaseConnection

End Sub

根据excel电子表格Sheet1中添加的数据，用户应该能够根据需要上传尽可能多的测试用例。

我知道有一个Excel加载项可以执行此操作，但是运行宏并自行设置所有内容更加容易和方便，这就是为什么我要提出这个特定的宏的原因。