如何使用宏或 VbScript 为 Excel 使用 'Export to HP ALM' 插件
How to use 'Export to HP ALM' Addin for Excel using Macro or VbScript
我正在尝试找到一种方法来自动将 excel 中的手动测试用例上传到 ALM。我一直在使用“Export to HP ALM”插件。但是,此过程是手动的,因为您需要 select 范围并遵循此插件的 向导 步骤。
是否可以通过 Macro/vbscript 使用此插件?或者有什么方法可以通过 OTA 使用此插件中使用的相同地图名称?
更新 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
我正在尝试找到一种方法来自动将 excel 中的手动测试用例上传到 ALM。我一直在使用“Export to HP ALM”插件。但是,此过程是手动的,因为您需要 select 范围并遵循此插件的 向导 步骤。
是否可以通过 Macro/vbscript 使用此插件?或者有什么方法可以通过 OTA 使用此插件中使用的相同地图名称?
更新 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