Use Case:

The user wants to highlight a test plan, and export the steps to Excel so they can easily be printed.  This is easiest implemented by adding a custom button. 


Solution:

Add a button to the Test Plan module. 


 

'(in action can execute)
  if ActionName = "UserDefinedActions.ExportTest" Then
 
     Call User_ExportTest
 
  End if
 
Sub User_ExportTest
    Dim CountRec
    Dim TestPlanID
    TestPlanID = Test_Fields.Field("TS_TEST_ID").Value
    Set TDC = TDConnection
    Set Com = TDC.Command
    Com.CommandText = "SELECT TS_NAME, TS_DESCRIPTION, "  & _
        "DS_STEP_NAME, DS_DESCRIPTION, DS_EXPECTED "  & _
        "FROM TEST " & _
        "INNER JOIN DESSTEPS " & _
        "ON TEST.TS_TEST_ID = DESSTEPS.DS_TEST_ID WHERE TEST.TS_TEST_ID = " & TestPlanID
 
    Set recset = Com.Execute
    CountRec = recset.RecordCount
 
    If CountRec <1 Then
 
    Else
            recset.First
        Set objEXCEL = CreateObject("Excel.Application")
        objEXCEL.visible = TRUE
        objEXCEL.workbooks.add
        objEXCEL.DisplayAlerts = FALSE
 
        objEXCEL.cells(1,1).value = "Test Name"
        objEXCEL.cells(1,2).value = "Test Description"
        objEXCEL.cells(1,3).value = "Step Name"
        objEXCEL.cells(1,4).value = "Step Description"
        objEXCEL.cells(1,5).value = "Expected Result"
 
        For i=1 to CountRec
            objEXCEL.cells(i+1,1).value = recset(0)
            objEXCEL.cells(i+1,2).value = recset(1)
            objEXCEL.cells(i+1,3).value = recset(2)
            objEXCEL.cells(i+1,4).value = recset(3)
            objEXCEL.cells(i+1,5).value = recset(4)
            recset.Next
        Next
 
        objEXCEL.Cells.Select
        objEXCEL.Selection.RowHeight = 15
        objEXCEL.Selection.Replace "<html>", ""
        objEXCEL.Selection.Replace "</html>", ""
        objEXCEL.Selection.Replace "<body>", ""
        objEXCEL.Selection.Replace "</body>", ""
        objEXCEL.Selection.Replace "<div align=" &chr(34)& "left" &chr(34)& "><font face=" &chr(34)& "Arial" &chr(34)& "><span style=" &chr(34)& "font-size:8pt" &chr(34)& ">", ""
        objEXCEL.Selection.Replace "</span></font></div>", ""
        objEXCEL.Columns("A:C").Select
        objEXCEL.Selection.Replace chr(10), ""
 
        'objEXCEL.Rows("1:1").Select
                 'With objEXCEL.cells("1:1").Interior.ColorIndex = 0
                      '.Pattern = xlSolid
                      '.PatternColorIndex = xlAutomatic
                      '.ThemeColor = xlThemeColorLight1
                      '.TintAndShade = 0
                      '.PatternTintAndShade = 0
                 'End With
                 'With objEXCEL.Selection.Font
                      '.ThemeColor = xlThemeColorDark1
                      '.TintAndShade = 0
                 'End With
                 'With ActiveWindow
                      '.SplitColumn = 0
                      '.SplitRow = 1
                 'End With
        'objEXCEl.ActiveWindow.FreezePanes = True
        objEXCEL.Cells(1,1).Select
 
    End if
 
End Sub

 

Also,

This code might work depending on what type of environment is set up.  We find the regex function is best for removing HTML:

 

Function RemoveHTML( strText )
  Dim RegEx
  Set RegEx = New RegExp

  strText = Replace(strText, "<html>" & vbCrLf & "<body>"  & vbCrLf, "")
  strText = Replace(strText,  vbCrLf & "</body>" & vbCrLf & "</html>", "")

  RegEx.Pattern = "<[^>]*>"
  RegEx.Global = True

  RemoveHTML = RegEx.Replace(strText, "")
End Function


Sub Template_ExportTestPlan()
    On Error GoTo 0
    Dim CountRec
    Dim TestPlanID
    Dim TDC, Com, recset, objEXCEL, i
    TestPlanID = Test_Fields.Field("TS_TEST_ID").Value
    Set TDC = TDConnection
    Set Com = TDC.Command
    Com.CommandText = "SELECT TS_NAME, TS_DESCRIPTION, "  & _
        "DS_STEP_NAME, DS_DESCRIPTION, DS_EXPECTED "  & _
        "FROM TEST " & _
        "INNER JOIN DESSTEPS " & _
        "ON TEST.TS_TEST_ID = DESSTEPS.DS_TEST_ID WHERE TEST.TS_TEST_ID = " & TestPlanID

    Set recset = Com.Execute
    CountRec = recset.RecordCount

    If CountRec <1 Then
          Msgbox "General Error:", 16, "No Records were retrieved. Please contact your administrator. Error #1002"
    Else
        recset.First

        Set objEXCEL = CreateObject("Excel.Application")
        objEXCEL.visible = TRUE
        objEXCEL.workbooks.add
        objEXCEL.DisplayAlerts = FALSE

        objEXCEL.cells(1,1).value = "Test Name"
        objEXCEL.cells(1,2).value = "Test Description"
        objEXCEL.cells(1,3).value = "Step Name"
        objEXCEL.cells(1,4).value = "Step Description"
        objEXCEL.cells(1,5).value = "Expected Result"

        For i=1 to CountRec
            objEXCEL.cells(i+1,1).value = RemoveHTML(recset(0))
            objEXCEL.cells(i+1,2).value = RemoveHTML(recset(1))
            objEXCEL.cells(i+1,3).value = RemoveHTML(recset(2))
            objEXCEL.cells(i+1,4).value = RemoveHTML(recset(3))
            objEXCEL.cells(i+1,5).value = RemoveHTML(recset(4))
            recset.Next
        Next
        objEXCEL.Cells(1,1).Select

    End if
End Sub