原文章地址：

http://www.sqaforums.com/showthreaded.php?Number=567717

设计思路如下：

here comes the excel report, I made the modification from report manager and wrapped into 2 main functions to be called in QTP.
Function initReport()
runtime = Date & "-"& Hour(Now) & Minute(Now)& Second(Now)
folderPath = "D:\QTP_Framework\report\"&runtime
call CreatFolderIfNotExist(folderPath)
call WriteFile_Append("D:\QTP_Framework\report\config.mse",folderPath)
End Function
Function ReportQTP(testCaseName, result, Comment)
fullPath = ReadLastLine("D:\QTP_Framework\report\config.mse")
ReportExcelFile = fullPath &"\report.xls"
CaptureFilePath = fullPath
Environment("TCase") = testCaseName
Call Report(result, comment, ReportExcelFile, CaptureFilePath)
End Function
'GetIP is the IP add of the execution machine
Public Function GetIP
ComputerName="."
Dim objWMIService,colItems,objItem,objAddress
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
GetIP = objAddress
Exit Function
End If
Next
Next
End Function
'Report is the function for reporting
'sStatus is the status of execution, valid input are :FAIL?PASS, WARNING
'sDetails is the comment/notes for this execution
Public Function Report(sStatus,sDetails, ReportExcelFile, CaptureFilePath)
Dim fso
Dim oExcel
Dim ExcelFile
Dim TestcaseName
Dim objWorkBook
Dim objSheet
Dim NewTC
Dim Status
Dim temp
Dim PngPath
Set fso = CreateObject("scripting.FileSystemObject")
Set oExcel = CreateObject("Excel.Application")
Status=UCase(sStatus)
oExcel.Visible = false 'True
'Setting excel forms
If Not fso.FileExists(ReportExcelFile)Then
oExcel.Workbooks.Add
'Get the first sheet of excel
Set objSheet = oExcel.Sheets.Item(1)
oExcel.Sheets.Item(1).Select
With objSheet
.Name = "Testing Result"
'testing results
.Columns("A:A").ColumnWidth = 5
.Columns("B:B").ColumnWidth = 35
.Columns("C:C").ColumnWidth = 12.5
.Columns("D:D").ColumnWidth = 60
.Columns("A:D").HorizontalAlignment = -4131
.Columns("A:D").WrapText = True
'set the font's type and size
.Range("A:D").Font.Name = "Arial"
.Range("A:D").Font.Size = 10
'
.Range("B1").Value = "Testing Results"
.Range("B1:C1").Merge
'set the style of the head of the file
.Range("B1:C1").Interior.ColorIndex = 53
.Range("B1:C1").Font.ColorIndex = 19
.Range("B1:C1").Font.Bold = True
'set the execution date
.Range("B3").Value = "Test Date:"
.Range("B4").Value = "Test Start Time:"
.Range("B5").Value = "Test End Time:"
.Range("B6").Value = "Test Duration: "
.Range("C3").Value = Date
.Range("C4").Value = Time
.Range("C5").Value = Time
.Range("C6").Value = "=R[-1]C-R[-2]C"
.Range("C6").NumberFormat = "[h]:mm:ss;@"
'Set the Borders for the Date & Time Cells
.Range("C3:C8").HorizontalAlignment = 4 'right align
.Range("C3:C8").Font.Bold = True
.Range("C3:C8").Font.ColorIndex = 7
.Range("B3:C8").Borders(1).LineStyle = 1
.Range("B3:C8").Borders(2).LineStyle = 1
.Range("B3:C8").Borders(3).LineStyle = 1
.Range("B3:C8").Borders(4).LineStyle = 1
'Format the Date and Time Cells
.Range("B3:C8").Interior.ColorIndex = 40
.Range("B3:C8").Font.ColorIndex = 12
.Range("C3:C8").Font.ColorIndex = 7
.Range("B3:A8").Font.Bold = True
.Range("B7").Value = "No Of Testcases:"
.Range("C7").Value = "0"
.Range("B8").Value = "Testing Machine:"
.Range("C8").Value =GetIP()
.Range("B10").Value = "Test Case name"
.Range("C10").Value = "Testing results"
.Range("D10").Value = "Notes"
' set style for Result Summery
.Range("B10:D10").Interior.ColorIndex = 53
.Range("B10:D10").Font.ColorIndex = 19
.Range("B10:D10").Font.Bold = True
'set style for Result Summery
.Range("B10:D10").Borders(1).LineStyle = 1
.Range("B10:D10").Borders(2).LineStyle = 1
.Range("B10:D10").Borders(3).LineStyle = 1
.Range("B10:D10").Borders(4).LineStyle = 1
.Range("B10:D10").HorizontalAlignment = -4131
.Range("C11:C1000").HorizontalAlignment = -4131
.Columns("B:D").Select
' .Columns("B:D").Autofit
.Range("B11").Select
End With
oExcel.ActiveWindow.FreezePanes = True
oExcel.ActiveWorkbook.SaveAs ReportExcelFile
oExcel.Quit
Set objSheet = Nothing
End If
TestcaseName = Environment("TCase")
Set objWorkBook = oExcel.Workbooks.Open(ReportExcelFile)
Set objSheet = oExcel.Sheets("Testing Result")
With objSheet
Environment.Value("Row") = .Range("C7").Value + 11
NewTC = False
If TestcaseName <> objSheet.Cells(Environment("Row")-1,2).value Then
.Cells(Environment("Row"),2).value = TestcaseName
.Cells(Environment("Row"), 3).Value = Status
.Cells(Environment("Row"), 4).value = sDetails
.Cells(Environment("Row"), 5).value = "click this link to see ScreenShot"
Select Case Status
Case "FAIL"
.Range("C" & Environment("Row")).Font.ColorIndex = 3
temp = Date & "-"& Hour(Now) & Minute(Now)& Second(Now)
PngPath = CaptureFilePath & "\" & temp & ".png"
.Hyperlinks.Add objSheet.Cells(Environment("Row"), 5), PngPath, "",""
Call Capture(temp, CaptureFilePath)
Case "PASS"
.Range("C" & Environment("Row")).Font.ColorIndex = 50
temp = Date & "-"& Hour(Now) & Minute(Now)& Second(Now)
PngPath = CaptureFilePath & "\" & temp & ".png"
.Hyperlinks.Add objSheet.Cells(Environment("Row"), 5), PngPath, "",""
Call Capture(temp, CaptureFilePath)
Case "WARNING"
.Range("C" & Environment("Row")).Font.ColorIndex = 5
temp = Date & "-"& Hour(Now) & Minute(Now)& Second(Now)
PngPath = CaptureFilePath & "\" & temp & ".png"
.Hyperlinks.Add objSheet.Cells(Environment("Row"), 5), PngPath, "",""
Call Capture(temp, CaptureFilePath)
End Select
NewTC = True
.Range("C7").Value = .Range("C7").Value + 1
'set board
.Range("B" & Environment("Row") & ":D" & Environment("Row")).Borders(1).LineStyle = 1
.Range("B" & Environment("Row") & ":D" & Environment("Row")).Borders(2).LineStyle = 1
.Range("B" & Environment("Row") & ":D" & Environment("Row")).Borders(3).LineStyle = 1
.Range("B" & Environment("Row") & ":D" & Environment("Row")).Borders(4).LineStyle = 1
'set font type and color
.Range("B" & Environment("Row") & ":D" & Environment("Row")).Interior.ColorIndex = 19
.Range("B" & Environment("Row")).Font.ColorIndex = 53
.Range("D" & Environment("Row")).Font.ColorIndex = 41
.Range("B" & Environment("Row") & ":D" & Environment("Row")).Font.Bold = True
End If
If (Not NewTC) And (Status = "FAIL") Then
.Cells(Environment("Row"), 3).Value = "Fail"
.Range("C" & Environment("Row")).Font.ColorIndex = 3
end If
'update end time
.Range("C5").Value = Time
.Columns("B:D").Select
'.Columns("B:D").Autofit
End With
oExcel.ActiveWindow.FreezePanes = True
'save result
objWorkBook.Save
oExcel.Quit
Set objSheet = Nothing
Set objWorkBook = Nothing
Set oExcel = Nothing
Set fso = Nothing
End Function
Public Function Capture(fileNo, CaptureFilePath)
Dim datestamp
Dim filename
datestamp = Now()
filename = fileNo & ".png"
'filename = Replace(filename,"/","")
'filename = Replace(filename,":","")
filename = CaptureFilePath + "\" + ""&filename
Desktop.CaptureBitmap filename
'Reporter.ReportEvent micFail,"image","<img src='" & filename & "'>"
End Function
'Append to txt file
Public Function WriteFile_Append(pathway,words)
Dim fileSystemObj,fileSpec,logFile,way
Set fileSystemObj = CreateObject("Scripting.FileSystemObject")
fileSpec = pathway
Set logFile = fileSystemObj.OpenTextFile(fileSpec, 8, true)
logFile.WriteLine (CStr(words))
logFile.Close
Set logFile = Nothing
End Function
'Read last line of txt file
Function ReadLastLine(pathway)
Dim fso,myfile
Set fso=CreateObject("scripting.FileSystemObject")
Set myfile = fso.openTextFile(pathway,1,false)
While Not myfile.AtEndOfLine
temp = myfile.ReadLine
Wend
ReadLastLine = temp
End Function
Function CreatFolderIfNotExist(fldr)
Dim fso, msg
Set fso = CreateObject("Scripting.FileSystemObject")
If Not (fso.FolderExists(fldr)) Then
Set f = fso.CreateFolder(fldr)
End If
End Function