Как использовать надстройку "Экспорт в HP ALM" для Excel, используя Macro или VbScript
Я пытаюсь найти способ автоматизировать загрузку тестовых примеров вручную в Excel в ALM. Я использую надстройку " Экспорт в HP ALM ". Тем не менее, этот процесс выполняется вручную, так как вам нужно выбрать диапазон и следовать указаниям мастера, подобным шагам этого дополнения.
Есть ли способ использовать этот Addin с помощью Macro/vbscript? или есть ли способ использовать то же имя карты, которое используется в этом дополнении через OTA?
Обновление 1:
Нашел способ решения вышеуказанного вопроса (ответ выложен ниже). Однако мне нужно ускорить процесс, то есть сократить время загрузки. Любая помощь в этом?
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