Good Afternoon,
I am trying to prevent the team I work with from accidentally deleting test cases from the Test Plan View. The issue is that when I us the Test_CanDelete(Entity, IsTest) IsTest is always False, I don’t know if this is an invalid Entity Value or something else.
The following is my code:
Function Test_CanDelete(Entity, IsTest)
On Error Resume Next
‘ TS_USER_03 = Is Deleted
‘ TS_USER_04 = Deleted By
Test_CanDelete = DefaultRes
enter code hereDim intTest
Dim objTSTF
Dim objTF
Dim objFilter
Dim lstTests
Dim strS
Msgbox IsTest
If (IsTest) Then
‘ First, disallow any "real" deletion
Test_CanDelete = False
‘ Find out if the test is in any test sets.
intTest = Entity.Field("TS_TEST_ID")
Set objTSTF = TDConnection.TSTestFactory
Set objFilter = objTSTF.Filter
objFilter.Filter("TC_TEST_ID") = intTest
Set lstTests = objTSTF.NewList(objFilter.Text)
Msgbox lstTests ‘Debugging Test Count
If lstTests.Count = 0 Then
‘ The test is not in any test sets, and may be "deleted"
‘ Set a flag on the test to mark it as deleted
Entity.Field("TS_NAME") = Entity.Field("TS_NAME") & " " _ & Replace(Replace(Now, "/", "-"), ":", "")
Entity.Field("TS_SUBJECT") = 2 ‘ Move to Subject root folder
Else
‘The test is in at least one test set, and may not be "deleted"
If lstTests.Count = 1 Then
strS = "."
Else
strS = "s."
End If
MsgBox "The selected test is in " & lstTests.Count & " test set" & strS _
& VBCrLf & "You may not delete the test.", vbExclamation, _
"Test Cannot Be Deleted" ‘ vbExclamation = 48
End If
‘ Regardless of the outcome, clear the objects
Set lstTests = Nothing
Set objFilter = Nothing
Set objTSTF = Nothing
Else
‘ This is Not a Test. Thus, it must be a folder. That’s a SubjectNode object
If Entity.Count > 0 Then
Msgbox Entity.Count
MsgBox "This folder contains other folders." & VBCrLf & _
"You may not delete it until it is empty.", vbExclamation, _
"Folder Not Deleted" ‘ vbExclamation = 48
Test_CanDelete = False
Else
‘ It has no folders, but may have tests.
Set objTF = Entity.TestFactory
Set lstTests = objTF.NewList("")
‘msgbox lstTests.Count
If lstTests.Count > 0 Then
If lstTests.Count = 1 Then
strS = "a test."
Else
strS = "tests."
End If
MsgBox "This folder contains " & strS & VBCrLf & _
"You may not delete it until it is empty.", vbExclamation, _
"Folder Not Deleted" ‘ vbExcalamation = 48
Test_CanDelete = False
Else
‘ There are no tests in this folder
Test_CanDelete = True
End If
Set lstTests = Nothing
Set objTF = Nothing
End If
End If
NewPlanAction=Actions.Action("act_filter_refresh")
NewPlanAction.Execute
On Error GoTo 0
End Function
Thank you for any help you can provide.