Importer des cas de test de QC

Question

J'ai le code suivant pour le téléchargement des cas de test. Il ne télécharge rien, mais quand je suis déjà connecté, cela fonctionne. QC stocke la description au format HTML. Donc, avant de le stocker dans Excel, StripHTML() va supprimer toutes les balises HTML et mettre textes seulement. Aussi nouvelle balise de ligne <br> est remplacée par une nouvelle ligne caractère chr(10) dans Excel afin que tous les nouveaux textes de ligne apparaît correctement:

fpath = "Root\Regression" 
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:H4") 
     .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) = "Description" 
    .Cells(4, 5) = "Status" 
    .Cells(4, 6) = "Step Name" 
    .Cells(4, 7) = "Step Description(Action)" 
    .Cells(4, 8) = "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, StripHTML() 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 = StripHTML(Replace(TestCase.Field("TS_DESCRIPTION"), _ 
    "<br>", Chr(10))) 
     .Cells(Row, 5).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, 6).Value = DesignStep.StepName 
       .Cells(Row, 7).Value = StripHTML(Replace(DesignStep.StepDescription, _ 
"<br>", Chr(10))) 
       .Cells(Row, 8).Value = StripHTML(Replace(DesignStep.StepExpectedResult, _ 
"<br>", Chr(10))) 
       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 StripHTML(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 
With RegEx 
    .Global = True 
    .IgnoreCase = True 
    .MultiLine = True 
    .Pattern = "<[^>]+>" 'Regular Expression for HTML Tags. 
End With 
sOut = RegEx.Replace(sInput, "") 
StripHTML = sOut 
Set RegEx = Nothing 
End Function 

Answer 1

Try This,

Avant d'exécuter cette s'il vous plaît remplir les champs obligatoires. Entrez le nom de domaine en C1 cellulaire, Entrez le nom du projet dans la cellule C2, Entrez dossier Nom de chemin dans la cellule C3 (par exemple. Objet \ 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, "&ndash;", "Ð") 
    sInput = Replace(sInput, "&mdash;", "Ñ") 
    sInput = Replace(sInput, "&iexcl;", "Á") 
    sInput = Replace(sInput, "&iquest;", "À") 
    sInput = Replace(sInput, "&quot;", "") 
    sInput = Replace(sInput, "&ldquo;", "Ò") 
    sInput = Replace(sInput, "&rdquo;", "Ó") 
    sInput = Replace(sInput, "", "'") 
    sInput = Replace(sInput, "&lsquo;", "Ô") 
    sInput = Replace(sInput, "&rsquo;", "Õ") 
    sInput = Replace(sInput, "&laquo;", "Ç") 
    sInput = Replace(sInput, "&raquo;", "È") 
    sInput = Replace(sInput, "&nbsp;", " ") 
    sInput = Replace(sInput, "&amp;", "&") 
    sInput = Replace(sInput, "&cent;", "¢") 
    sInput = Replace(sInput, "&copy;", "©") 
    sInput = Replace(sInput, "&divide;", "Ö") 
    sInput = Replace(sInput, "&gt;", ">") 
    sInput = Replace(sInput, "&lt;", "<") 
    sInput = Replace(sInput, "&micro;", "µ") 
    sInput = Replace(sInput, "&middot;", "á") 
    sInput = Replace(sInput, "&para;", "¦") 
    sInput = Replace(sInput, "&plusmn;", "±") 
    sInput = Replace(sInput, "&euro;", "Û") 
    sInput = Replace(sInput, "&pound;", "£") 
    sInput = Replace(sInput, "&reg;", "¨") 
    sInput = Replace(sInput, "&sect;", "¤") 
    sInput = Replace(sInput, "&trade;", "ª") 
    sInput = Replace(sInput, "&yen;", "´") 
    sInput = Replace(sInput, "&aacute;", "‡") 
    sInput = Replace(sInput, "&Aacute;", "ç") 
    sInput = Replace(sInput, "&agrave;", "ˆ") 
    sInput = Replace(sInput, "&Agrave;", "Ë") 
    sInput = Replace(sInput, "&acirc;", "‰") 
    sInput = Replace(sInput, "&Acirc;", "å") 
    sInput = Replace(sInput, "&aring;", "Œ") 
    sInput = Replace(sInput, "&Aring;", "") 
    sInput = Replace(sInput, "&atilde;", "‹") 
    sInput = Replace(sInput, "&Atilde;", "Ì") 
    sInput = Replace(sInput, "&auml;", "Š") 
    sInput = Replace(sInput, "&Auml;", "€") 
    sInput = Replace(sInput, "&aelig;", "¾") 
    sInput = Replace(sInput, "&AElig;", "®") 
    sInput = Replace(sInput, "&ccedil;", "") 
    sInput = Replace(sInput, "&Ccedil;", "‚") 
    sInput = Replace(sInput, "&eacute;", "Ž") 
    sInput = Replace(sInput, "&Eacute;", "ƒ") 
    sInput = Replace(sInput, "&egrave;", "") 
    sInput = Replace(sInput, "&Egrave;", "é") 
    sInput = Replace(sInput, "&ecirc;", "") 
    sInput = Replace(sInput, "&Ecirc;", "æ") 
    sInput = Replace(sInput, "&euml;", "‘") 
    sInput = Replace(sInput, "&Euml;", "è") 
    sInput = Replace(sInput, "&iacute;", "’") 
    sInput = Replace(sInput, "&Iacute;", "ê") 
    sInput = Replace(sInput, "&igrave;", "“") 
    sInput = Replace(sInput, "&Igrave;", "í") 
    sInput = Replace(sInput, "&icirc;", "”") 
    sInput = Replace(sInput, "&Icirc;", "ë") 
    sInput = Replace(sInput, "&iuml;", "•") 
    sInput = Replace(sInput, "&Iuml;", "ì") 
    sInput = Replace(sInput, "&ntilde;", "–") 
    sInput = Replace(sInput, "&Ntilde;", "„") 
    sInput = Replace(sInput, "&oacute;", "—") 
    sInput = Replace(sInput, "&Oacute;", "î") 
    sInput = Replace(sInput, "&ograve;", "˜") 
    sInput = Replace(sInput, "&Ograve;", "ñ") 
    sInput = Replace(sInput, "&ocirc;", "™") 
    sInput = Replace(sInput, "&Ocirc;", "ï") 
    sInput = Replace(sInput, "&oslash;", "¿") 
    sInput = Replace(sInput, "&Oslash;", "¯") 
    sInput = Replace(sInput, "&otilde;", "›") 
    sInput = Replace(sInput, "&Otilde;", "Í") 
    sInput = Replace(sInput, "&ouml;", "š") 
    sInput = Replace(sInput, "&Ouml;", "…") 
    sInput = Replace(sInput, "&szlig;", "§") 
    sInput = Replace(sInput, "&uacute;", "œ") 
    sInput = Replace(sInput, "&Uacute;", "ò") 
    sInput = Replace(sInput, "&ugrave;", "") 
    sInput = Replace(sInput, "&Ugrave;", "ô") 
    sInput = Replace(sInput, "&ucirc;", "ž") 
    sInput = Replace(sInput, "&Ucirc;", "ó") 
    sInput = Replace(sInput, "&uuml;", "Ÿ") 
    sInput = Replace(sInput, "&Uuml;", "†") 
    sInput = Replace(sInput, "&yuml;", "Ø") 
    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 

Hope this helps ...

Cordialement, Ashwin