请求优化HP ALM测试用例上传VBA宏，支持批量上传

首先我们需要给Excel里的测试用例数据设定一个识别规则，这样宏才能区分不同测试用例的边界。这里默认你的Sheet1数据结构是：

• 每个测试用例的主信息行（包含名称、描述、负责人等）：第3列（C列）不为空
• 该测试用例的步骤行：第3列（C列）为空，且属于上一个非空C列的用例

基于这个规则，我们可以修改现有代码，添加外层循环来遍历所有测试用例，同时为每个用例匹配对应的步骤。

修改后的完整VBA代码 #

Sub upload_test_cases()
    Dim wd, QCConnection, sProject, sTestPlanPath, TestFolderPath, strNodeByPath
    Dim tsf, trmgr, subjectfldr, trfolder, sampleTest, dsf, dstep
    Dim qcURL As String, sDomain As String, sUser As String, sPass As String
    Dim folder As String, subfolder As String
    Dim currentTCStartRow As Integer, nextTCStartRow As Integer, lastRow As Integer
    Dim i As Integer
    
    ' ALM连接配置（可根据需求改回InputBox方式）
    qcURL = "http://url:8080/qcbin/"
    If qcURL = "" Then
        MsgBox ("ALM URL cannot be blank")
        Exit Sub
    End If
    
    sDomain = "" ' 替换为你的Domain
    If sDomain = "" Then
        MsgBox ("DomainName cannot be blank")
        Exit Sub
    End If
    
    sProject = "" ' 替换为你的Project
    If sProject = "" Then
        MsgBox ("ProjectName cannot be blank")
        Exit Sub
    End If
    
    sUser = InputBox("Please enter your Username" & vbNewLine & "Eg:MSID", "", "")
    If sUser = "" Then
        MsgBox ("UserName cannot be blank")
        Exit Sub
    End If
    
    sPass = InputBox("Please enter your Password", "", "")
    If sPass = "" Then
        MsgBox ("Password cannot be blank")
        Exit Sub
    End If
    
    ' 初始化ALM连接
    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")
    
    ' 获取文件夹信息（假设所有测试用例都上传到同一个文件夹）
    folder = Worksheets("Sheet1").Cells(2, 1).Value ' 主文件夹
    subfolder = Worksheets("Sheet1").Cells(2, 2).Value ' 子文件夹
    
    ' 创建ALM文件夹（如果不存在）
    On Error Resume Next
    Set trfolder = subjectfldr.AddNode(folder)
    trfolder.Post
    Set subjectfldr = trmgr.NodebyPath("Subject\" & folder)
    
    If subfolder <> "" Then
        Set trfolder = subjectfldr.AddNode(subfolder)
        trfolder.Post
    End If
    On Error GoTo 0
    
    ' 定位目标文件夹
    If subfolder = "" Then
        Set trfolder = trmgr.NodebyPath("Subject\" & folder)
    Else
        Set trfolder = trmgr.NodebyPath("Subject\" & folder & "\" & subfolder)
    End If
    
    ' 获取Sheet1的最后一行
    lastRow = Worksheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
    currentTCStartRow = 2 ' 第一个测试用例从第2行开始
    
    ' 外层循环：遍历每个测试用例
    Do While currentTCStartRow <= lastRow
        ' 跳过空的测试用例名称行
        If Trim(Worksheets("Sheet1").Cells(currentTCStartRow, 3).Value) = "" Then
            currentTCStartRow = currentTCStartRow + 1
            Continue Do
        End If
        
        ' 找到下一个测试用例的起始行（下一个非空C列的行）
        nextTCStartRow = currentTCStartRow + 1
        Do While nextTCStartRow <= lastRow And Trim(Worksheets("Sheet1").Cells(nextTCStartRow, 3).Value) = ""
            nextTCStartRow = nextTCStartRow + 1
        Loop
        
        ' 创建当前测试用例
        Set sampleTest = trfolder.TestFactory.AddItem(Null)
        sampleTest.Field("TS_NAME") = Worksheets("Sheet1").Cells(currentTCStartRow, 3).Value ' 测试用例名称
        sampleTest.Field("TS_DESCRIPTION") = Worksheets("Sheet1").Cells(currentTCStartRow, 4).Value ' 描述
        sampleTest.Field("TS_RESPONSIBLE") = Worksheets("Sheet1").Cells(currentTCStartRow, 8).Value ' 负责人
        sampleTest.Post
        
        ' 内层循环：上传当前测试用例的所有步骤
        Set dsf = sampleTest.DesignStepFactory
        For i = currentTCStartRow To nextTCStartRow - 1
            ' 跳过空步骤（如果有的话）
            If Trim(Worksheets("Sheet1").Cells(i, 5).Value) <> "" Then
                Set dstep = dsf.AddItem(Null)
                dstep.StepName = Worksheets("Sheet1").Cells(i, 5).Value ' 步骤名称
                dstep.StepDescription = Worksheets("Sheet1").Cells(i, 6).Value ' 步骤描述
                dstep.StepExpectedResult = Worksheets("Sheet1").Cells(i, 7).Value ' 预期结果
                dstep.Post
            End If
        Next i
        
        ' 移动到下一个测试用例的起始行
        currentTCStartRow = nextTCStartRow
    Loop
    
    ' 清理对象并断开ALM连接
    Set dstep = Nothing
    Set dsf = Nothing
    Set sampleTest = Nothing
    Set trfolder = Nothing
    Set subjectfldr = Nothing
    Set trmgr = Nothing
    Set tsf = Nothing
    
    QCConnection.Disconnect
    QCConnection.Logout
    QCConnection.ReleaseConnection
    Set QCConnection = Nothing
    
    MsgBox "所有测试用例已成功上传！"
End Sub

关键修改点说明 #

1. 测试用例边界识别：

   • 通过查找非空的C列单元格确定每个测试用例的起始行
   • 用nextTCStartRow变量定位下一个测试用例的起始位置，从而明确当前用例的步骤范围（从currentTCStartRow到nextTCStartRow-1）

2. 外层循环遍历所有用例：

   • 使用Do While循环遍历每个测试用例的起始行，直到表格末尾
   • 自动跳过空的测试用例名称行，避免无效操作

3. 步骤上传优化：

   • 内层循环仅处理当前测试用例范围内的行
   • 添加空步骤判断，跳过无内容的步骤行

4. 代码健壮性提升：

   • 明确声明所有变量，避免隐式类型转换问题
   • 完善对象清理逻辑，防止内存泄漏
   • 添加最终成功提示，提升用户体验

使用注意事项 #

• 确保Excel数据符合约定结构：测试用例主信息行C列非空，步骤行C列空
• 如果需要调整列对应关系，直接修改代码中列的索引即可（比如Cells(i,3)对应C列，Cells(i,5)对应E列）
• 可根据需求把固定的qcURL、sDomain、sProject改回InputBox方式，让用户每次运行时输入

内容的提问来源于stack exchange，提问作者pyrish