原文章地址：

设计思路如下：

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