Downloading the Test to local PC

[Jay]

hai Cnu,

You can download the scripts from QC to your local system without any admin rights.

call the first function with required details

Code:

If qtApp.TDConnection.IsConnected Then ' If connection is successful

    Set tdc = qtApp.TDConnection.TDOTA
    Set TreeMgr = tdc.TreeManager
    
    ' Use TreeManager.RootList to get the Subject root.
    Set Trees = TreeMgr.RootList(TDOLE_SUBJECT)
    Set MyTrees = TreeMgr.NodeByPath(strTestPlanProjectPath)
    
    If MyTrees.Count = 0 Then
        ModuleName = ""
        testPath = MyTrees.Path
        strFSPath = strSharedFolderPath
        Call CreateFolder(strFSPath)
        If iReplyA = "Yes" Then
            strFSAPath = strFSPath & "\" & Trim(ModuleName) & " Attachments\"
            Call CreateFolder(strFSAPath)
        End If
        Call DownloadScripts(qtApp, tdc, testPath, strFSPath, ModuleName)
        If iReplyA = "Yes" Then
            Call DownloadAttachements(qtApp, tdc, testPath, strFSAPath)
        End If
    End If

   Call CreateFolder(strSharedFolderPath)
  
   For iChild = 1 To MyTrees.Count
        ModuleName = Trim(MyTrees.Child(iChild).Name)
        strFSPath = strSharedFolderPath & "\" & ModuleName
        Call CreateFolder(strFSPath)
        If iReplyA = "Yes" Then
             strFSAPath = strFSPath & "\" & ModuleName & " Attachments\"
            Call CreateFolder(strFSAPath)
        End If
        Set Locate = MyTrees.FindChildNode(ModuleName)
        testPath = Locate.Path
        Call DownloadScripts(qtApp, tdc, testPath, strFSPath, ModuleName)
        If iReplyA = "Yes" Then
            Call DownloadAttachements(qtApp, tdc, testPath, strFSAPath)
        End If
    Next
    
qtApp.TDConnection.Disconnect ' Disconnect from Quality Center

Else
    Msgbox "Cannot connect to Quality Center" ' If connection is not successful, display an error message.
End If

' Exit QuickTest
qtApp.Quit

' Release the Application object
Set qtApp = Nothing
Set Locate = Nothing
Set MyTrees = Nothing
Set Trees = Nothing
Set TreeMgr = Nothing
Set tdc = Nothing

Msgbox "Download Process is completed"

End Sub
Function CreateFolder(strFolderPath)

   Dim fso, f
   Set fso = CreateObject("Scripting.FileSystemObject")

   If Not (fso.FolderExists(strFolderPath)) Then
        Set f = fso.CreateFolder(strFolderPath)
        Set f = Nothing
   End If

   Set fso = Nothing
  
End Function

Function DownloadScripts(qtApp, tdc, testPath, strFSPath, ModuleName)

    For Each oTestSet In tdc.TreeManager.NodeByPath(testPath).TestFactory.NewList("")
            
            ScriptName = oTestSet.Name
            Script = "[QualityCenter] " & testPath & "\" & ScriptName
            ScriptFSScript = strFSPath & "\" & ScriptName
            
            resFlag = ""
            Flag = False
            On Error Resume Next
            qtApp.Open Script, False ' Open the test
            If Err.Number <> 0 Then
            Flag = True
            End If
            qtApp.Test.SaveAs ScriptFSScript
            If Err.Number <> 0 Then
            Flag = True
            Else
            qtApp.Test.Close
            End If
            
            If Flag = True Then
                resFlag = "Error: " & Err.Description
                Flag = False
                Err.Clear
            Else
                resFlag = "Pass"
            End If
            Call WriteScriptNames(strFSPath, ScriptName, ModuleName, resFlag)
            
            resFlag = ""
Next
End Function

~ Jay Patel