Попробуйте это,
Перед запуском этого, пожалуйста, заполните обязательные поля. Введите имя домена в ячейке C1, Введите название проекта в ячейке C2, Введите имя папки, путь в ячейке C3 (например. При условии \ Test_Folder1 \ Child_Folder1)
Sub EmportTestCases()
On Error Resume Next
Dim QCConnection
Dim sUserName, sPassword
Dim sDomain, sProject
Dim TstFactory, TestList
Dim TestCase
'Create QC Connection Object to connect to QC
Set QCConnection = CreateObject("TDApiOle80.TDConnection")
sUserName = "USerName" '<-----------------change Me
sPassword = "Password" '<-----------------change Me
QCConnection.InitConnectionEx "http://<server_Name>:<port>/qcbin" '<-----------------change Me
'Authenticate your user ID and Password
QCConnection.Login sUserName, sPassword
'Quit if QC Authentication fails
If (QCConnection.LoggedIn <> True) Then
MsgBox "QC User Authentication Failed"
End
End If
sDomain = Range("C1").Value 'Enter Domain name in Cell C1
sProject = Range("C2").Value 'Enter Project name in Cell C2
fpath = Range("C3").Value 'Enter Folder Path name in Cell C3
'Login to your Domain and Project
QCConnection.Connect sDomain, sProject
'Quit if login fails to specified Domain and Project
If (QCConnection.AuthenticationToken = "") Then
MsgBox "QC Project Failed to Connect to " & sProject
QCConnection.Disconnect
End
End If
'Now successful connection is made to QC
'Get the test factory
Set TstFactory = QCConnection.TestFactory
' Your QC Project Path for which you want to download
' the test cases.
Set myfilter = TstFactory.Filter()
myfilter.Filter("TS_SUBJECT") = "^" & fpath & "^"
'Get a list of all test cases for your specified path
Set TestList = myfilter.NewList()
'Format the header before downloading the test cases
With ActiveSheet
.Range("B5").Select
With .Range("B4:I4")
.Font.Name = "Arial"
.Font.FontStyle = "Bold"
.Font.Size = 10
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 15
End With
.Cells(4, 2) = "Subject (Folder Name)"
.Cells(4, 3) = "Test Name (Manual Test Plan Name)"
.Cells(4, 4) = "Test Type"
.Cells(4, 5) = "Description"
.Cells(4, 6) = "Status"
.Cells(4, 7) = "Step Name"
.Cells(4, 8) = "Step Description(Action)"
.Cells(4, 9) = "Expected Result"
Dim Row
Row = 5 '- set the data row from 5
'loop through all the test cases.
For Each TestCase In TestList
.Cells(Row, 2).Value = TestCase.Field("TS_SUBJECT").Path
.Cells(Row, 3).Value = TestCase.Field("TS_NAME")
'QC stores description in html format. So before storing it
'in to excel, RemoveHTML() will remove all HTML tags and put
'texts only. Also new line tag <br> is replaced with new line
'character chr(10) in excel so that all the new line texts appears properly
.Cells(Row, 4).Value = TestCase.Field("TS_TYPE")
.Cells(Row, 5).Value = RemoveHTML(Replace(TestCase.Field("TS_DESCRIPTION"), "<br>", Chr(10)))
.Cells(Row, 6).Value = TestCase.Field("TS_EXEC_STATUS")
'Get the DesignStepFactory for the this testcase
Dim DesignStepFactory, DesignStep, DesignStepList
Set DesignStepFactory = TestCase.DesignStepFactory
Set DesignStepList = DesignStepFactory.NewList("")
'Check if design steps exists for the test
If DesignStepList.Count <> 0 Then
'loop for all the steps for this test case
For Each DesignStep In DesignStepList
.Cells(Row, 7).Value = DesignStep.Field("DS_STEP_NAME")
.Cells(Row, 8).Value = RemoveHTML(DesignStep.Field("DS_DESCRIPTION"))
.Cells(Row, 9).Value = RemoveHTML(DesignStep.Field("DS_EXPECTED"))
Row = Row + 1
Next 'next Step
End If
' release the design step objects
Set DesignStepFactory = Nothing
Set DesignStep = Nothing
Set DesignStepList = Nothing
Next ' Next test case
End With
'Release the object
Set DesignStepFactory = Nothing
Set DesignStep = Nothing
Set DesignStepList = Nothing
Set TstFactory = Nothing
Set TestList = Nothing
Set TestCase = Nothing
QCConnection.Disconnect
MsgBox ("All Test cases are downloaded with Test Steps")
End Sub
Function RemoveHTML(sInput As String) As String
Dim RegEx As Object
Set RegEx = CreateObject("vbscript.regexp")
'Dim sInput As String
Dim sOut As String
'sInput = cell.Text
sInput = Replace(sInput, "\x0D\x0A", Chr(10))
sInput = Replace(sInput, "\x00", Chr(10))
sInput = Replace(sInput, "</P>", Chr(10) & Chr(10))
sInput = Replace(sInput, "<BR>", Chr(10))
sInput = Replace(sInput, "<li>", "-")
sInput = Replace(sInput, "–", "Ð")
sInput = Replace(sInput, "—", "Ñ")
sInput = Replace(sInput, "¡", "Á")
sInput = Replace(sInput, "¿", "À")
sInput = Replace(sInput, """, "")
sInput = Replace(sInput, "“", "Ò")
sInput = Replace(sInput, "”", "Ó")
sInput = Replace(sInput, "", "'")
sInput = Replace(sInput, "‘", "Ô")
sInput = Replace(sInput, "’", "Õ")
sInput = Replace(sInput, "«", "Ç")
sInput = Replace(sInput, "»", "È")
sInput = Replace(sInput, " ", " ")
sInput = Replace(sInput, "&", "&")
sInput = Replace(sInput, "¢", "¢")
sInput = Replace(sInput, "©", "©")
sInput = Replace(sInput, "÷", "Ö")
sInput = Replace(sInput, ">", ">")
sInput = Replace(sInput, "<", "<")
sInput = Replace(sInput, "µ", "µ")
sInput = Replace(sInput, "·", "á")
sInput = Replace(sInput, "¶", "¦")
sInput = Replace(sInput, "±", "±")
sInput = Replace(sInput, "€", "Û")
sInput = Replace(sInput, "£", "£")
sInput = Replace(sInput, "®", "¨")
sInput = Replace(sInput, "§", "¤")
sInput = Replace(sInput, "™", "ª")
sInput = Replace(sInput, "¥", "´")
sInput = Replace(sInput, "á", "‡")
sInput = Replace(sInput, "Á", "ç")
sInput = Replace(sInput, "à", "ˆ")
sInput = Replace(sInput, "À", "Ë")
sInput = Replace(sInput, "â", "‰")
sInput = Replace(sInput, "Â", "å")
sInput = Replace(sInput, "å", "Œ")
sInput = Replace(sInput, "Å", "")
sInput = Replace(sInput, "ã", "‹")
sInput = Replace(sInput, "Ã", "Ì")
sInput = Replace(sInput, "ä", "Š")
sInput = Replace(sInput, "Ä", "€")
sInput = Replace(sInput, "æ", "¾")
sInput = Replace(sInput, "Æ", "®")
sInput = Replace(sInput, "ç", "")
sInput = Replace(sInput, "Ç", "‚")
sInput = Replace(sInput, "é", "Ž")
sInput = Replace(sInput, "É", "ƒ")
sInput = Replace(sInput, "è", "")
sInput = Replace(sInput, "È", "é")
sInput = Replace(sInput, "ê", "")
sInput = Replace(sInput, "Ê", "æ")
sInput = Replace(sInput, "ë", "‘")
sInput = Replace(sInput, "Ë", "è")
sInput = Replace(sInput, "í", "’")
sInput = Replace(sInput, "Í", "ê")
sInput = Replace(sInput, "ì", "“")
sInput = Replace(sInput, "Ì", "í")
sInput = Replace(sInput, "î", "”")
sInput = Replace(sInput, "Î", "ë")
sInput = Replace(sInput, "ï", "•")
sInput = Replace(sInput, "Ï", "ì")
sInput = Replace(sInput, "ñ", "–")
sInput = Replace(sInput, "Ñ", "„")
sInput = Replace(sInput, "ó", "—")
sInput = Replace(sInput, "Ó", "î")
sInput = Replace(sInput, "ò", "˜")
sInput = Replace(sInput, "Ò", "ñ")
sInput = Replace(sInput, "ô", "™")
sInput = Replace(sInput, "Ô", "ï")
sInput = Replace(sInput, "ø", "¿")
sInput = Replace(sInput, "Ø", "¯")
sInput = Replace(sInput, "õ", "›")
sInput = Replace(sInput, "Õ", "Í")
sInput = Replace(sInput, "ö", "š")
sInput = Replace(sInput, "Ö", "…")
sInput = Replace(sInput, "ß", "§")
sInput = Replace(sInput, "ú", "œ")
sInput = Replace(sInput, "Ú", "ò")
sInput = Replace(sInput, "ù", "")
sInput = Replace(sInput, "Ù", "ô")
sInput = Replace(sInput, "û", "ž")
sInput = Replace(sInput, "Û", "ó")
sInput = Replace(sInput, "ü", "Ÿ")
sInput = Replace(sInput, "Ü", "†")
sInput = Replace(sInput, "ÿ", "Ø")
sInput = Replace(sInput, "", "«")
sInput = Replace(sInput, "", "`")
With RegEx
.Global = True
.IgnoreCase = True
.MultiLine = False
.Pattern = "<[^>]+>" 'Regular Expression for HTML Tags.
End With
sOut = RegEx.Replace(sInput, "")
RemoveHTML = Replace(sOut, Chr(10), "")
Set RegEx = Nothing
End Function
Надеется, что это помогает ...
С уважением, Ashwin