使用vbs生成的测试报告

几年前，貌似是2012年，本身作自动化时，用的还都是QTP，说实话QTP本身生成的测试报告很不直观，通常都要本身定制测试报告。还好QTP使用的是vbs，因而本身就动手定制了一个。比较实用，下面是我基于vbs作的这个测试报告的源码：

一、源码

Dim varReportName        ' 测试报告文件名
Const cSheet1Name = "结果概览"
Const cSheet2Name = "详细结果"

'描述：GetIP    捕获运行脚本的电脑ＩＰ
Public Function GetInfo
    ComputerName="."
    Dim objWMIService,colItems,objItem,objAddress,username,localhostname
	username = Environment("UserName")
	localhostname = Environment("LocalHostName")
    Set objWMIService = GetObject("winmgmts:\\" & ComputerName & "\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
    For Each objItem in colItems
        For Each objAddress in objItem.IPAddress
            If objAddress <> "" then
                GetInfo = "本机IP："&objAddress &vbcrlf&"用户名："&username&vbcrlf&"机器名："&localhostname
                Exit Function
            End If
        Next
    Next
End Function

Sub ExcelReport(ByVal vStatus, ByRef vDetails, ByRef vRemarks)

    Dim objExcel        ' object of Excel
    Dim objExcelBook    ' object of Excel WorkBook
    Dim vActionName        ' QTP Test Name
    Dim vSummaryRow, vResultRow, vNewAction, vUCaseStatus
    
    vActionName = Environment("TestName" )& " － " & Environment("ActionName")
'    vActionName = "ExcelReporter － Action "
    vUCaseStatus = UCase(vStatus)
    If varReportName = Empty Then
        varReportName = Environment ("TestDir")& "\" &Replace(Now,":","") & "测试报告" &".xls"
     'varReportName = "D:\测试报告" & Date & second(now)&".xls"
        Call CreateExcelReport(varReportName)
    End If
    
    Set objExcel = CreateObject("Excel.Application")
    Set objExcelBook = objExcel.Workbooks.Open(varReportName)
'    objExcel.Visible = True        'Debug
    
    ' Test Summary Sheet
    objExcel.Sheets(cSheet1Name).Select
    With objExcel.Sheets(cSheet1Name)
        vSummaryRow = .Range("C7").Value + 11
        vResultRow = .Range("C8").Value + 2*.Range("C7").Value + 2
        vNewAction = False
        
        If .Cells(vSummaryRow - 1, 2).Value <> vActionName Then        ' 新增Action
            .Cells(vSummaryRow, 2).Value = vActionName
            objExcel.ActiveSheet.Hyperlinks.Add .Cells(vSummaryRow, 2), "", cSheet2Name&"!A"&vResultRow+1, vActionName&" Result"
            .Cells(vSummaryRow, 3).Value = vStatus
            Select Case vUCaseStatus
                Case "FAIL"
                    .Range("C" & vSummaryRow).Font.ColorIndex = 3
                Case "PASS"
                    .Range("C" & vSummaryRow).Font.ColorIndex = 50
                Case "WARNING"
                    .Range("C" & vSummaryRow).Font.ColorIndex = 5              
            End Select
            vNewAction = True
            .Cells(vSummaryRow, 4).Value = 1
            .Range("C7").Value = .Range("C7").Value + 1
            'Set color and Fonts
            .Range("B" & vSummaryRow & "" & vSummaryRow).Borders(1).LineStyle = 1 
            .Range("B" & vSummaryRow & "" & vSummaryRow).Borders(2).LineStyle = 1
            .Range("B" & vSummaryRow & "" & vSummaryRow).Borders(3).LineStyle = 1
            .Range("B" & vSummaryRow & ":D" & vSummaryRow).Borders(4).LineStyle = 1
            .Range("B" & vSummaryRow & ":D" & vSummaryRow).Interior.ColorIndex = 19
            .Range("B" & vSummaryRow).Font.ColorIndex = 53
        Else
            .Range("D" & vSummaryRow-1).Value = .Range("D" & vSummaryRow-1).Value + 1
        End If
        
        If (Not vNewAction) And (vUCaseStatus = "FAIL") Then        ' 重复Action Test而且vStatus为Fail
            .Cells(vSummaryRow-1, 3).Value = vStatus
            .Range("C" & vSummaryRow-1).Font.ColorIndex = 3
        End If

        If (Not vNewAction) And (vUCaseStatus = "PASS") Then        ' 重复Action Test而且vStatus为Warning,若是结果为Warning，也标注为Pass
            If UCase(.Cells(vSummaryRow-1, 3).Value) = "PASS" Then
                .Cells(vSummaryRow-1, 3).Value = vStatus
                .Range("C" & vSummaryRow-1).Font.ColorIndex = 5
            End If
        End If

        .Range("C8").Value = .Range("C8").Value + 1
        .Range("C5").Value = Time
    End With

    ' Test Result Sheet
    objExcel.Sheets(cSheet2Name).Select
    With objExcel.Sheets(cSheet2Name)
        If vNewAction Then
            .Range("A" & vResultRow & ":D" & vResultRow).Interior.ColorIndex = 15
            .Range("A" & vResultRow & ":D" & vResultRow).Merge
            vResultRow = vResultRow + 1
            .Range("A" & vResultRow & ":D" & vResultRow).Merge
            .Range("A" & vResultRow & ":D" & vResultRow).HorizontalAlignment = 1
            .Range("A" & vResultRow).Value = vActionName
            'Set color and Fonts
            .Range("A" & vResultRow & ":D" & vResultRow).Interior.ColorIndex = 19
            .Range("A" & vResultRow & ":D" & vResultRow).Font.ColorIndex = 53
            .Range("A" & vResultRow & ":D" & vResultRow).Font.Bold = True
            vResultRow = vResultRow + 1
            .Range("A" & vResultRow).Value = "Step "&objExcel.Sheets(cSheet1Name).Range("D" & vSummaryRow).Value
        Else
            .Range("A" & vResultRow).Value = "Step "&objExcel.Sheets(cSheet1Name).Range("D" & vSummaryRow-1).Value
        End If
        .Range("B" & vResultRow).Value = vStatus
        .Range("C" & vResultRow).Value = vDetails
        .Range("D" & vResultRow).Value = vRemarks
        
        Select Case vUCaseStatus
            Case "PASS"
                .Range("B" & vResultRow).Font.ColorIndex = 50
            Case "FAIL"
                .Range("A" & vResultRow & ":E" & vResultRow).Font.ColorIndex = 3
            Case "WARNING"
                .Range("A" & vResultRow & ":E" & vResultRow).Font.ColorIndex = 5
        End Select

        'Set the Borders
        .Range("A" & vResultRow & ":D" & vResultRow).Borders(1).LineStyle = 1
        .Range("A" & vResultRow & ":D" & vResultRow).Borders(2).LineStyle = 1
        .Range("A" & vResultRow & ":D" & vResultRow).Borders(3).LineStyle = 1
        .Range("A" & vResultRow & ":D" & vResultRow).Borders(4).LineStyle = 1        
    End With
    
    objExcel.Sheets(cSheet1Name).Select
    objExcelBook.Save
    objExcel.Quit
    Set objExcelBook = Nothing
    Set objExcel = Nothing    
End Sub


'==================================================
' Create Excel Report File
'==================================================
Sub CreateExcelReport(ByRef vFileName)
    Dim fso                ' object of FSO
    Dim objExcel        ' object of Excel
    
    Set fso = CreateObject("scripting.FileSystemObject")
    Set objExcel = CreateObject("Excel.Application")
    If objExcel Is Nothing Then MsgBox "系统未检测到安装了EXCEL！"
    objExcel.DisplayAlerts = False
'    objExcel.Visible = True        'Debug

'    生成报告并设置格式
    If  Not fso.FileExists(varReportName) Then
        objExcel.Workbooks.Add
        ' Test Summary Sheet
        objExcel.Sheets.Item(1).Select
        With objExcel.Sheets.Item(1)
            .Name = cSheet1Name
'            设置显示方式
            .Columns("A:A").ColumnWidth = 10
            .Columns("B:B").ColumnWidth = 45
            .Columns("C:C").ColumnWidth = 25
            .Columns("D:D").ColumnWidth = 25
            .Columns("A:D").WrapText = False
            .Columns("C:C").HorizontalAlignment = -4108        ' 4，右对齐；-4108，居中
            .Range("C3:C8").HorizontalAlignment = 4
			.Range("C9:C9").HorizontalAlignment = 1
            .Range("B10:D10").HorizontalAlignment = -4108
            .Range("A:D").VerticalAlignment = -4160
            .Range("B2:C2").Merge
            .Range("B1:C1").Interior.ColorIndex = 31
            .Range("B2:C2").Interior.ColorIndex = 31
            .Range("B10:D10").Interior.ColorIndex = 31
            .Range("B3:C9").Interior.ColorIndex = 24
            .Range("B2:C2").Font.ColorIndex = 19
            .Range("B10:D10").Font.ColorIndex = 19
            .Range("B3:C9").Font.ColorIndex = 12
            .Range("B2:B9").Borders(1).LineStyle = 1    ' 1，单线；-4115，点线；-4119，双线
            .Range("C2:C9").Borders(2).LineStyle = 1
           ' .Range("B2:C2").Borders(3).LineStyle = 1
            .Range("B8:C9").Borders(4).LineStyle = 1
            .Range("B3:C9").Borders(3).LineStyle = 1
            .Range("C3:C9").Borders(1).LineStyle = 1
            .Range("B2:B9").Font.Bold = True
            .Range("B10:D10").Font.Bold = True
            .Range("A:D").Font.Name = "Arial"
            .Range("A:D").Font.Size = 10
			.Range("B11:B500").Font.Size = 10
            .Range("B2").Font.Size = 12
            .Range("B10:D10").Font.Size = 12
'            设置单元格内容
            .Range("B2").Value = "结果概览"
            .Range("B3").Value = "测试日期:"
            .Range("B4").Value = "测试开始时间:"
            .Range("B5").Value = "测试结束时间:"
            .Range("B6").Value = "测试用时: "   
            .Range("B7").Value = "测试用例数:"
            .Range("B8").Value = "总运行步骤:"
			 .Range("B9").Value = "测试机器:"
            .Range("C3").Value = Date&" "&WeekDayName(Weekday(Date)) 
            .Range("C4").Value = Time
            .Range("C5").Value = Time
            .Range("C6").Value = "=R[-1]C-R[-2]C"
            .Range("C6").NumberFormat = "[h]:mm:ss;@"
            .Range("C7").Value = "0"
            .Range("C8").Value = "0"
			.Range("C9").Value =GetInfo()
            .Range("B10").Value = "用例名称"
            .Range("C10").Value = "测试结果"
            .Range("D10").Value = "测试步骤"
           ' .Columns("B:D").Autofit
            .Range("B11").Select
           objExcel.ActiveWindow.FreezePanes = True
        End With
        ' Test Result Sheet
        objExcel.Sheets.Item(2).Select
        With objExcel.Sheets.Item(2)
            .Name = cSheet2Name
            'Set color and Fonts        
            .Columns("A:A").ColumnWidth = 45
            .Columns("B:B").ColumnWidth = 45
            .Columns("C:D").ColumnWidth = 55
            .Columns("C:D").WrapText = True
            .Columns("A:B").HorizontalAlignment = -4108        ' 4，右对齐；-4108，居中
            .Range("A:D").VerticalAlignment = -4160
            .Range("A:D").Font.Name = "Arial"
            .Range("A1:D1").Interior.ColorIndex = 31
            .Range("A1:D1").Font.ColorIndex = 19
            .Range("A1:D1").Borders(1).LineStyle = 1 
            .Range("A1:D1").Borders(2).LineStyle = 1
            .Range("A1:D1").Borders(3).LineStyle = 1
            .Range("A1:D1").Borders(4).LineStyle = 1
            .Range("A1:D1").Font.Bold = True
'            设置单元格内容
            .Range("A1").Value = "测试用例"
            .Range("B1").Value = "运行结果"
            .Range("C1").Value = "结果说明"
            .Range("D1").Value = "结果备注"
            .Range("A2").Select
           objExcel.ActiveWindow.FreezePanes = True
        End With
    
        objExcel.ActiveWorkbook.SaveAs vFileName
        objExcel.Quit
    End If
End Sub

二、演示

直接调用上面的两个方法便可：createExcelReport用于建立报告，ExcelReport用于添加数据。调用后的效果：

点击报告链接：AlcFrameTest-Action1，则会挑到详细结果页：