SPONSORS:






User Tag List

Thanks Thanks:  0
Likes Likes:  0
Dislikes Dislikes:  0
Results 1 to 4 of 4
  1. #1
    New Member
    Join Date
    Sep 2007
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Total Downloaded
    0

    Copying Test to another folder with VBA Script

    Hi all,

    need to consolidate tests from several folders into a new folder in plan. Any idea how to copy the VBA OTA Test object to a new one?

    Thanks for your help.

    Ahoi, Joe from Munich
    (The Oktoberfest is starting on Saturday!!!)
    [img]/images/graemlins/smirk.gif[/img]

  2. #2
    New Member
    Join Date
    Sep 2007
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Total Downloaded
    0

    Re: Copying Test to another folder with VBA Script

    It's been solved.
    Thanks.

  3. #3
    Junior Member
    Join Date
    Mar 2007
    Posts
    7
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Total Downloaded
    0

    Re: Copying Test to another folder with VBA Script

    would you share with us

  4. #4
    New Member
    Join Date
    Sep 2007
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)
    Total Downloaded
    0

    Re: Copying Test to another folder with VBA Script

    Hi all,

    the initial situation has its reason in copying test case structures and following modifications. This is an abuse use of the PLAN module but this bull**** i find at the customer.
    The script consolidates test cases residing in several base folders of the PLAN module of TestDirector. It will copy the whole contens (structures and test cases) of the given folders to a destination folder. In case of equal test names, it keeps only the test with the higher Version Time Stamp.

    It would be great to get valuable suggestions and ingenious advancements from you.

    Ahoi, Joe


    <font class="small">Code:</font><hr /><pre>Option Explicit
    Public goTDConnection As TDAPIOLELib.TDConnection
    Public publicDestFolder As String
    Public publicSrcFolder As String

    Public Sub Main()
    On Error GoTo 0
    Dim publicSrcFolderNames(6) As String
    Dim srcNode As SubjectNode
    Dim srcTM As TreeManager
    Dim a As Integer


    If Not ConnectTD Then
    End
    End If

    publicSrcFolderNames(1) = "BaseNode1"
    publicSrcFolderNames(2) = "BaseNode2"
    publicSrcFolderNames(3) = "BaseNode3"
    publicSrcFolderNames(4) = "BaseNode4"
    publicSrcFolderNames(5) = "BaseNode5"
    publicSrcFolderNames(6) = "BaseNode6"

    publicDestFolder = "zzConsolidate"

    Set srcTM = goTDConnection.TreeManager

    For a = 1 To 6
    publicSrcFolder = publicSrcFolderNames(a)
    'Set Base folder
    Set srcNode = srcTM.TreeRoot("Subject")
    srcNode.Refresh
    'set publicSrcFolder
    Set srcNode = srcNode.FindChildNode(publicSrcFolder)
    If srcNode Is Nothing Then
    MsgBox "Sorry, Source Folder not found."
    Call DisconnectTD
    End
    End If
    'running thru all nodes (recursiv call)
    Call ExpandNode(srcNode)
    Next
    Call DisconnectTD
    End Sub


    Private Sub ExpandNode(actualSrcNode As SubjectNode)
    On Error GoTo 0
    Dim NodeFilter As TDFilter
    Dim destTM As TreeManager
    Dim destNode As SubjectNode
    Dim destTestFact As TestFactory
    Dim srcTestFact As TestFactory
    Dim srcTest As test
    Dim nextSrcNode As SubjectNode
    Dim srcTestList As TDAPIOLELib.List
    Dim destTestList As TDAPIOLELib.List
    Dim i As Integer
    Dim a As Integer
    Dim dummyStr As String


    ' The FindTest method finds ALL Tests incl. all Tests out of all SubFoldern. Thats stupit
    ' So this will only perform folders with no subfolders. Tests in folders with subfolders will be ignored
    If actualSrcNode.Count &gt; 0 Then
    For i = 1 To actualSrcNode.Count
    Set nextSrcNode = actualSrcNode.FindChildNode(actualSrcNode.Child(i) .Name)
    Call ExpandNode(nextSrcNode)
    Next
    Else
    Set srcTestFact = actualSrcNode.TestFactory
    Set srcTestList = actualSrcNode.FindTests("")
    If (srcTestList Is Nothing) Then
    'noop
    ElseIf srcTestList.Count &gt; 0 Then
    'get dest path
    Set destNode = NaviToDestNode(actualSrcNode.Path)
    'look for tests in dest path
    Set destTestList = destNode.FindTests("")
    'testfactory at publicDestFolder for remove and copy/paste action
    Set destTestFact = destNode.TestFactory
    'cycle thru all tests at publicSrcFolder
    For i = 1 To srcTestList.Count
    Set srcTest = srcTestList.item(i)
    'tests are present?
    If (destTestList Is Nothing) Then
    'no, simply copy
    Call shCopyTest(destTestFact, srcTest.ID, destNode.NodeID)
    Else
    'tests are present?
    If destTestList.Count = 0 Then
    'no, simply copy
    Call shCopyTest(destTestFact, srcTest.ID, destNode.NodeID)
    Else
    'cycle thru all tests at dest folder
    For a = 1 To destTestList.Count
    'find tests with equal names
    'little trick, because sometimes item(?) throws an error
    dummyStr = "#*"
    On Error Resume Next
    dummyStr = destTestList.item(a).Name
    On Error GoTo 0
    If dummyStr &lt;&gt; "#*" Then
    If srcTest.Name = destTestList.item(a).Name Then
    'compare Version Time Stamp
    If srcTest.Field("TS_VTS") &gt; destTestList.item(a).Field("TS_VTS") Then
    'if Test in publicSrcFolder is younger remove Test in publicDestFolder
    destTestFact.RemoveItem (destTestList.item(a).ID)
    Call shCopyTest(destTestFact, srcTest.ID, destNode.NodeID)
    End If
    Exit For
    End If
    End If
    Next
    'no eqal test name found
    If a &gt; destTestList.Count Then
    Call shCopyTest(destTestFact, srcTest.ID, destNode.NodeID)
    End If
    End If
    End If
    Set NodeFilter = Nothing
    Set srcTest = Nothing
    Next
    Set destTestFact = Nothing
    Set srcTestList = Nothing
    Set destTestList = Nothing
    End If
    End If
    End Sub


    Function NaviToDestNode(SrcNodePath) As SubjectNode
    ' navigates to a given path, if nodes are not existing they will be added
    On Error GoTo LocalErrorHandler
    Dim remainPath As String
    Dim nextNode As String
    Dim x As Integer
    Dim NodeNotFound As Boolean
    Dim destTM As TreeManager
    Set destTM = goTDConnection.TreeManager
    Set NaviToDestNode = destTM.TreeRoot("Subject")
    NaviToDestNode.Refresh
    Set NaviToDestNode = NaviToDestNode.FindChildNode(publicDestFolder)
    remainPath = Right(SrcNodePath, Len(SrcNodePath) - (7 + 1 + Len(publicSrcFolder) + 1))
    Do
    x = InStr(remainPath, "\")
    If x = 0 Then
    nextNode = remainPath
    remainPath = ""
    Else
    nextNode = Left(remainPath, x - 1)
    remainPath = Right(remainPath, Len(remainPath) - x)
    End If
    NodeNotFound = False
    Set NaviToDestNode = NaviToDestNode.FindChildNode(nextNode)
    If NodeNotFound Then
    Set NaviToDestNode = NaviToDestNode.AddNode(nextNode)
    End If
    If remainPath = "" Then
    Exit Do
    End If
    Loop
    Exit Function
    LocalErrorHandler:
    NodeNotFound = True
    Resume Next
    End Function



    Sub shCopyTest(sourceTestFactory As TestFactory, sourceTestID, destNodeID)
    On Error GoTo LocalErrorHandler
    Dim iscp As ISupportCopyPaste
    Dim clipboard As String
    Set iscp = sourceTestFactory
    clipboard = iscp.CopyToClipBoard(sourceTestID, 0, "")
    iscp.PasteFromClipBoard clipboard, destNodeID, 0, -1
    Set iscp = Nothing
    Exit Sub
    LocalErrorHandler:
    MsgBox Err.Description
    On Error Resume Next
    Exit Sub
    End Sub
    </pre><hr />

 

 

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Search Engine Optimisation provided by DragonByte SEO v2.0.36 (Pro) - vBulletin Mods & Addons Copyright © 2016 DragonByte Technologies Ltd.
Resources saved on this page: MySQL 11.54%
vBulletin Optimisation provided by vB Optimise v2.6.4 (Pro) - vBulletin Mods & Addons Copyright © 2016 DragonByte Technologies Ltd.
User Alert System provided by Advanced User Tagging v3.2.8 (Pro) - vBulletin Mods & Addons Copyright © 2016 DragonByte Technologies Ltd.
vBNominate (Lite) - vBulletin Mods & Addons Copyright © 2016 DragonByte Technologies Ltd.
Feedback Buttons provided by Advanced Post Thanks / Like (Pro) - vBulletin Mods & Addons Copyright © 2016 DragonByte Technologies Ltd.
Username Changing provided by Username Change (Free) - vBulletin Mods & Addons Copyright © 2016 DragonByte Technologies Ltd.
BetaSoft Inc.
Digital Point modules: Sphinx-based search
All times are GMT -8. The time now is 06:39 AM.

Copyright BetaSoft Inc.