OTA第一篇用例根据自定义格式批量导出....

小孩

OTA第一篇用例根据自定义格式批量导出....
     大家可以参考一下代码 修改为自己定义的格式,导出的文件格式为WORD
   实现了功能，代码质量没有考虑 哈哈，请大家别介意

Dim QCConnection As TDConnection
    Dim Test As Test
    Dim TestFactory As TestFactory
    Dim TestList
    Dim StepFactory As DesignStepFactory
    Dim Step As DesignStep
    Dim StepList
    Dim str As String

    Dim documentName As String
    Dim wordApp As Word.Application
    documentName = "软件测试说明.doc"
    Dim conn     As adodb.Connection
    Dim strConnect     As String
    Dim rs     As New adodb.Recordset
    Dim strSql     As String
    Set wordApp = CreateObject("Word.Application")
     '使文档可见 0不可见
    wordApp.Application.Visible = 0
    Dim myDoc As Word.Document
    Set myDoc = wordApp.Documents.Add() '页面
    With wordApp
Set QCConnection = New TDAPIOLELib.TDConnection
     QCConnection.InitConnectionEx "http://XXXXXXX/qcbin"
     QCConnection.ConnectProjectEx "DEFAULT", "XXXXXXX", "XXXXXXX", "XXXXXXX"
     Set TestFactory = QCConnection.TestFactory

For Each Test In TestList
         .Selection.Font.name = "黑体"
         .Selection.Font.Size = 16
         .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
         .Selection.TypeText Text:="测试用例设计单"
         .Selection.EndKey Unit:=wdStory
         
         
         .Selection.Font.name = "宋体"
         .Selection.Font.Size = 12
         .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
         .Selection.EndKey Unit:=wdStory
        
        
        Set StepFactory = Test.DesignStepFactory
        Set StepList = StepFactory.NewList("")
        
         Set mytable = .ActiveDocument.Tables.Add(.Selection.Range, StepList.Count + 13, 5)
                With .Selection.Tables(1)
                    If .Style <> "网格型" Then
                        .Style = "网格型"
                    End If
                    .ApplyStyleHeadingRows = True
                    .ApplyStyleLastRow = True
                    .ApplyStyleFirstColumn = True
                    .ApplyStyleLastColumn = True
                End With
               
                '配置表格
                mytable.Columns(1).Width = 20
                mytable.Columns(3).Width = 140
                mytable.Cell(1, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(2, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(3, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(4, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(5, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(6, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(7, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(8, 1).Select
               .Selection.MoveRight wdCharacter, 4, wdExtend
               .Selection.Cells.Merge
            
               
               
                mytable.Cell(1, 2).Select
               .Selection.MoveRight wdCharacter, 2, wdExtend
               .Selection.Cells.Merge
            
               
               mytable.Cell(3, 2).Select
               .Selection.MoveRight wdCharacter, 2, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(4, 2).Select
               .Selection.MoveRight wdCharacter, 2, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(5, 2).Select
               .Selection.MoveRight wdCharacter, 2, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(6, 2).Select
               .Selection.MoveRight wdCharacter, 2, wdExtend
               .Selection.Cells.Merge
               
                mytable.Cell(7, 2).Select
               .Selection.MoveRight wdCharacter, 2, wdExtend
               .Selection.Cells.Merge
               
               
                mytable.Cell(StepList.Count + 10, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
            
               
               mytable.Cell(StepList.Count + 11, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(StepList.Count + 12, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(StepList.Count + 13, 1).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               
                mytable.Cell(StepList.Count + 10, 4).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
            
               
               mytable.Cell(StepList.Count + 11, 2).Select
               .Selection.MoveRight wdCharacter, 3, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(StepList.Count + 12, 4).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
               mytable.Cell(StepList.Count + 13, 4).Select
               .Selection.MoveRight wdCharacter, 1, wdExtend
               .Selection.Cells.Merge
               
            .Selection.EndKey Unit:=wdStory
            .Selection.InsertBreak Type:=wdPageBreak
               
            '输入字段名称
            mytable.Cell(1, 1).Range.InsertAfter "测试用例名称"
            mytable.Cell(2, 1).Range.InsertAfter "测试用例标识"
            mytable.Cell(2, 3).Range.InsertAfter "测试追踪"
            mytable.Cell(3, 1).Range.InsertAfter "测试用例描述"
            mytable.Cell(4, 1).Range.InsertAfter "测试方法"
            mytable.Cell(5, 1).Range.InsertAfter "测试类型"
            mytable.Cell(6, 1).Range.InsertAfter "前提和约束（包括初始化要求）"
            mytable.Cell(7, 1).Range.InsertAfter "测试终止条件"
            mytable.Cell(8, 1).Range.InsertAfter "测试过程"
            mytable.Cell(9, 1).Range.InsertAfter "序号"
            mytable.Cell(9, 2).Range.InsertAfter "输入及操作步骤"
            mytable.Cell(9, 3).Range.InsertAfter "期望测试结果"
            mytable.Cell(9, 4).Range.InsertAfter "评估准则"
            mytable.Cell(9, 5).Range.InsertAfter "实际测试结果"
            mytable.Cell(StepList.Count + 10, 1).Range.InsertAfter "设计人员"
            mytable.Cell(StepList.Count + 10, 3).Range.InsertAfter "设计日期"
            mytable.Cell(StepList.Count + 11, 1).Range.InsertAfter "问题标识"
            mytable.Cell(StepList.Count + 12, 1).Range.InsertAfter "执行结果"
            mytable.Cell(StepList.Count + 12, 3).Range.InsertAfter "测试人员"
            mytable.Cell(StepList.Count + 13, 1).Range.InsertAfter "测试监督员"
            mytable.Cell(StepList.Count + 13, 3).Range.InsertAfter "测试执行时间"
            
            str = CaseString(Test("ts_description"))
            str = Replace(str, "<html><body>", "")
            str = Replace(str, "&lt;", "<")
            str = Replace(str, "&gt;", ">")
            str = Replace(str, "</body></html>", "")
            str = Replace(str, "<br>", "")
            str = Replace(str, "<i>", "")
            str = Replace(str, "</i>", "")
            str = Replace(str, "<b>", "")
            str = Replace(str, "</b>", "")
            str = Replace(str, "<u>", "")
            str = Replace(str, "</u>", "")
            str = Replace(str, vbCrLf, "")
            Dim MyArray
            MyArray = Split(str, "〓", -1, 1)
         
            mytable.Cell(1, 2).Range.InsertAfter Test.name
            mytable.Cell(2, 2).Range.InsertAfter ""        '用例标示
            mytable.Cell(2, 4).Range.InsertAfter ""        '用例追踪
            mytable.Cell(3, 2).Range.InsertAfter MyArray(0)
            mytable.Cell(4, 2).Range.InsertAfter ""
            mytable.Cell(5, 2).Range.InsertAfter Test.Type
            mytable.Cell(6, 2).Range.InsertAfter MyArray(1)
            mytable.Cell(7, 2).Range.InsertAfter MyArray(2)
            mytable.Cell(StepList.Count + 10, 2).Range.InsertAfter Test("ts_responsible")
            mytable.Cell(StepList.Count + 10, 4).Range.InsertAfter Test("ts_creation_date")
            mytable.Cell(StepList.Count + 11, 2).Range.InsertAfter ""
            mytable.Cell(StepList.Count + 12, 2).Range.InsertAfter ""
            mytable.Cell(StepList.Count + 12, 4).Range.InsertAfter ""
            mytable.Cell(StepList.Count + 13, 2).Range.InsertAfter ""
            mytable.Cell(StepList.Count + 13, 4).Range.InsertAfter ""
            
            Dim I As Integer
            I = 1
            Dim StepName As String
            Dim StepDescription As String
            Dim StepExpectedResult As String
        For Each Step In StepList
              
              StepName = Step.StepName
              StepDescription = Step.StepDescription
              StepExpectedResult = Step.StepExpectedResult
              StepName = Replace(StepName, "步骤", "")
              StepName = Replace(StepName, "Step", "")
               StepName = Replace(StepName, "<html><body>", "")
               StepName = Replace(StepName, "&lt;", "<")
               StepName = Replace(StepName, "&gt;", ">")
               StepName = Replace(StepName, "</body></html>", "")
                StepName = Replace(StepName, "<br>", vbCrLf + "")
               
                StepDescription = Replace(StepDescription, "<html><body>", " ")
                StepDescription = Replace(StepDescription, "&lt;", "<")
               StepDescription = Replace(StepDescription, "&gt;", ">")
               StepDescription = Replace(StepDescription, "</body></html>", "")
                StepDescription = Replace(StepDescription, "<br>", vbCrLf + "")
               
                StepExpectedResult = Replace(StepExpectedResult, "<html><body>", "")
                StepExpectedResult = Replace(StepExpectedResult, "&lt;", "<")
               StepExpectedResult = Replace(StepExpectedResult, "&gt;", ">")
               StepExpectedResult = Replace(StepExpectedResult, "</body></html>", "")
                StepExpectedResult = Replace(StepExpectedResult, "<br>", vbCrLf + "")
            mytable.Cell(9 + I, 1).Range.InsertAfter StepName
            mytable.Cell(9 + I, 2).Range.InsertAfter StepDescription
            mytable.Cell(9 + I, 3).Range.InsertAfter StepExpectedResult

            I = I + 1
        Next
        
    Next

End With

小软susan

OTA是这样测的吗？疑惑啊~！