使用vbs生成的测试报告

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

1、源码

[code=language-vbscript]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

2、演示

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



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