QTP Framework:- Reporting function example

Report Function

' Create result file name along with creation date and time

'KillProcessAll "iexplore.exe"

'KillProcessAll "excel.exe"

Set WshShell = CreateObject("WScript.Shell")

ResultFilenamePath = ResultFolder & "\newScale_AutomationResults_"

varTime = Replace(Time, ":", "-")

varDate = Date

If InStr( varDate, "/") <> 0 Then

varDate = Replace(varDate, "/", "-")

End If

ResultFilenamePath = ResultFilenamePath & varDate &"_"& varTime

'msgbox ResultFilenamePath

strRunName = "Run_" & varDate &"_"& varTime

' Call create result file function to create result file, stored under logging_services_UM.vbs

createResultFile ResultFilenamePath

'################################################################################################

Private Function Check_Value_IN_Excel_Column(ByRef NewSheet,val)

For i = intResRowCnt to 1 step -1

If Cstr(NewSheet.Cells(i,1)) = Cstr(val) Then

Check_Value_IN_Excel_Column = True

Exit For

Else

Check_Value_IN_Excel_Column = False

End If

End Function

'######################################################################################################

'# Purpose: Copies template file from known folder to specified path

'# Method: createResultFile

'# Inputs: resFilePath (Datatype String, Result filename with full path)

'######################################################################################################

Public Function createResultFile(resFilePath)

'Copy the result template file

'On Error Resume next

Dim fso

'logger.LogInfo "createResultFile start"

Set fso = CreateObject("Scripting.FileSystemObject")

fso.CopyFile NEWSCALE_HOME & "\setup\templates\resulttemplate.xls", resFilePath & ".xls"

Set fso = Nothing

If Err.Number > 0 Then

'logger.LogError "createResultFile " & Err.Number & " " & Err.Description & " " & Err.Source

Err.Clear

End If

'logger.LogInfo "createResultFile end"

End Function

'######################################################################################################

'# Purpose: Opens given sheet in controller file

'# Method: OpenSheet

'# Inputs: Controller file handel, sheetname

'# Outputs: Handle to Sheet

'######################################################################################################

Public Function OpenSheet(ByRef ExcelObj, Byval sheet)

On Error Resume Next

' logger.LogInfo "OpenSheet start"

Dim sheetName

sheetName = 1

If Not isEmpty(sheet) Then sheetName = sheet

Set OpenSheet = ExcelObj.Sheets.Item(sheetName)

If Err.Number <> 0 Then

' logger.LogError "OpenSheet " & Err.Number & " " & Err.Description

End If

'logger.LogInfo "OpenSheet end"

End Function

'######################################################################################################

'# Purpose: Writes result to DetailedResult worksheet of resultfile

'# Method: reportResult

'# Inputs: strActualResult (Datatype String, result of the operation)

'# Outputs: None

'######################################################################################################

Public Function reportResult (ByRef NewSheet)

'On Error resume next

'msgbox intRowCnt

'msgbox strModuleName

'msgbox NewSheet.Cells(intRowCnt -1,1).Text

'If Not Check_Value_IN_Excel_Column(NewSheet,strModuleName) Then

NewSheet.Cells(intRowCnt , 1) = strModuleName

'End If

'If NewSheet.Cells(intRowCnt -1, 2) <> intRunStatus Then

'NewSheet.Cells(intRowCnt , 2) = intRunStatus

'End If

'If NewSheet.Cells(intRowCnt -1, 2) <> strTestCaseName Then

NewSheet.Cells(intRowCnt , 2) = strTestCaseName

'End If

NewSheet.Cells(intRowCnt , 3) = strStep

NewSheet.Cells(intRowCnt , 4) = strActRes

NewSheet.Cells(intRowCnt , 5) = strStatus

If (strStatus = "PASS") Then

NewSheet.Range("E" & intRowCnt).Font.ColorIndex = 50

NewSheet.Range("E" & intRowCnt).Font.Bold = True

else

NewSheet.Range("E" & intRowCnt).Font.ColorIndex = 3

NewSheet.Range("E" & intRowCnt).Font.Bold = True

End If

NewSheet.Cells(intRowCnt , 6) = Time ' execution time stamp

NewSheet.Range("A" & intRowCnt & ":L" & intRowCnt ).Font.Size = 8

resultFHand.ActiveWorkbook.Save

intRowCnt = intRowCnt + 1

End Function

'######################################################################################################

'# Purpose: Opens result file for writing

'# Method: OpenResultFile

'# Inputs: Result filename with complete path

'# Outputs: Handle to result file

'######################################################################################################

Public Function OpenResultFile(Byval ResultFilenamePath)

On Error Resume Next

' logger.LogInfo "OpenResultFile start"

Dim ExcelObj

Set ExcelObj = CreateObject("Excel.Application")

ExcelObj.Visible = False

ExcelObj.DisplayAlerts = False

ExcelObj.Workbooks.Open ResultFilenamePath

Set OpenResultFile = ExcelObj

If Err.Number <> 0 Then

' logger.LogError "OpenResultFile " & Err.Number & " " & Err.Description

End If

' logger.LogInfo "OpenResultFile end"

End Function

'######################################################################################################

'# Purpose: Find the difference between two time component and return the result in the format

'# xxHours yyMins zzSecs

'# Method: TimeDiff

'# Inputs: startTime (Datatype Time, Start time), endTime (Datatype Time, End Time)

'# Outputs: Datatype String, format xx hours yy mins zz seconds

'# Errors:

'# Asserts:

'# Developer Date Comments

'# --------- -------- --------

'######################################################################################################

Public Function TimeDiff(byval stTime, byval edTime)

Dim ts, th, tm, tsec

ts = DateDiff("s",stTime, edTime)

th = CInt(ts / 3600)

tm = CInt((ts - th * 3600) / 60)

If tm < 0 Then tm = 60 - Abs(tm): th = th - 1

tsec = CInt(ts - th * 3600 - tm * 60)

If tsec < 0 Then tsec = 60 - Abs(tsec): tm = tm - 1

TimeDiff = ""

If th <> 0 Then

TimeDiff = TimeDiff & th & " Hour"

End If

If tm <> 0 Then

TimeDiff = TimeDiff & " " & tm & " Min"

End If

If tsec <> "" Then

TimeDiff = TimeDiff & " " & tsec & " Sec"

End If

End Function

'######################################################################################################

'# Purpose: Function to be executed after stopping the run due to QTP run error

'# Method: Recovery_Run_Stopped

'######################################################################################################

Function Recovery_Run_Stopped(Object, Method, Arguments, retVal)

On error resume next

reporter.ReportEvent micFail, "Test Run Stopped","The The Test Run stopped due to QTP Run error"

Set dtsModuleSheet = OpenSheet(resultFHand,"Report by Module")

reportModuleResult dtsModuleSheet,resultFHand

endTime = Time

Set dtsHighLevSheet = OpenSheet(resultFHand,"High Level Report")

reportHighLevResult dtsHighLevSheet,resultFHand

End Function

'================================================================================

'######################################################################################################

'# Purpose: Writes result to DetailedResult worksheet of resultfile

'# Method: reportResult

'# Inputs: strActualResult (Datatype String, result of the operation)

'######################################################################################################

Public Function reportModuleResult (ByRef NewModuleSheet,ByRef resultFHand)

'On Error resume next

tempFlag = False

Set dtsActSheet = OpenSheet(resultFHand,"Report by Testcase")

srcRowCnt = dtsActSheet.UsedRange.Rows.Count

'msgbox srcRowCnt

For i = 2 to srcRowCnt

If Lcase(dtsActSheet.Cells(i,5).Text) = "fail" Then

stepFailCnt = stepFailCnt + 1

End If

passCount = 0

failCount = 0

intResRowCnt = intResRowCnt + 1

'msgbox intResRowCnt

NewModuleSheet.Cells(intResRowCnt, 5) = dtsActSheet.Cells(tempCount+1,6).Text

tempCount = tempCount +1

'msgbox tempCount

If tempCount > dtsActSheet.UsedRange.Rows.Count Then

tempFlag = True

Exit Do

End If

NewModuleSheet.Cells(intResRowCnt, 2) = dtsActSheet.Cells(tempCount,1).Text

NewModuleSheet.Cells(intResRowCnt, 3) = dtsActSheet.Cells(tempCount,2).Text

'NewModuleSheet.Cells(intResRowCnt, 5) = Cdate(dtsActSheet.Cells(tempCount,6).Text )

'msgbox tempCount

resultState = dtsActSheet.Cells(tempCount,5).Text

'msgbox LCase(Cstr(resultState))

If LCase(Cstr(resultState)) = "pass" Then

passCount = passCount + 1

Else

failCount = failCount + 1

End If

'msgbox passCount

'msgbox failCount

' msgbox (Cstr(Trim(dtsActSheet.Cells(tempCount,2).Text ))&" = "& CStr(Trim(dtsActSheet.Cells(tempCount+1,2).Text )))

Loop While (Cstr(Trim(dtsActSheet.Cells(tempCount,2).Text )) = CStr(Trim(dtsActSheet.Cells(tempCount+1,2).Text )))

'msgbox tempCount

NewModuleSheet.Cells(intResRowCnt, 6) = dtsActSheet.Cells(tempCount,6).Text

NewModuleSheet.Cells(intResRowCnt, 7) = TimeDiff (NewModuleSheet.Cells(intResRowCnt, 5) ,NewModuleSheet.Cells(intResRowCnt, 6))

If tempFlag Then

Exit Do

End If

If failCount = 0 Then

NewModuleSheet.Cells(intResRowCnt, 4) = "PASS"

NewModuleSheet.Range("D" & intResRowCnt).Font.ColorIndex = 50

NewModuleSheet.Range("D" & intResRowCnt).Font.Bold = True

Else

NewModuleSheet.Cells(intResRowCnt, 4) = "FAIL"

NewModuleSheet.Range("D" & intResRowCnt).Font.ColorIndex = 3

NewModuleSheet.Range("D" & intResRowCnt).Font.Bold = True

End If

'NewModuleSheet.Cells(intResRowCnt, 5) = timeDiff

NewModuleSheet.Cells(intResRowCnt, 1) = intSerialNumber

'msgbox NewModuleSheet.Cells(intResRowCnt, 1) &" "& NewModuleSheet.Cells(intResRowCnt, 2)&" "& NewModuleSheet.Cells(intResRowCnt, 3)&" "& NewModuleSheet.Cells(intResRowCnt, 4)&" "& NewModuleSheet.Cells(intResRowCnt, 5)&" "& NewModuleSheet.Cells(intResRowCnt, 6)

'msgbox strModuleName

intSerialNumber = intSerialNumber +1

' msgbox CStr(dtsActSheet.Cells(intResRowCnt,1).Text)&" = "&CStr(strModuleName)

Loop while CStr(dtsActSheet.Cells(intResRowCnt,1).Text) = CStr(strModuleName)

NewModuleSheet.Range("A" & intResRowCnt & ":L" & intResRowCnt).Font.Size = 8

resultFHand.ActiveWorkbook.Save

End Function

'######################################################################################################

'# Purpose: Writes high level results by reading module level results

'# Method: reportHighLevResult

'# Inputs: Newsheet handle and excel file handle

'# Outputs:

'# Errors:

'# Asserts:

'# Developer Date Comments

'# --------- -------- --------

'# Kalyan 14-Apr-2007 Created

'######################################################################################################

Public Function reportHighLevResult (ByRef NewHighLevSheet,ByRef resultFHand)

'On Error resume next

tempFlag = False

tempModuleResCnt = 1

totalTestCases = 0

totalPassCnt = 0

totalFailCnt = 0

Set dtsModSheet = OpenSheet(resultFHand,"Report by Module")

NewHighLevSheet.Cells(2 ,2) = "Test Summary of NSI as on "&now

NewHighLevSheet.Cells(3 ,2) = "Application URL :"& strAppURL &" (Build & Version: "& strBuildNumber &")"

NewHighLevSheet.Cells(10,3) = startTime

NewHighLevSheet.Cells(11,3) = endTime

NewHighLevSheet.Cells(12 ,3) = TimeDiff(startTime,endTime)

'msgbox dtsModSheet.UsedRange.Rows.Count

While (tempModuleResCnt < dtsModSheet.UsedRange.Rows.Count ) And (Cstr(Trim(dtsModSheet.Cells(tempModuleResCnt+1,2))) <> "")

'msgbox "The condition is "& tempModuleResCnt&"<="& dtsModSheet.UsedRange.Rows.Count

'msgbox "Condition is true entering 1st while loop"

'msgbox intHighLevResultCnt

testCaseCnt = 0

passCnt = 0

failCnt = 0

'msgbox "The Condition is "& Cstr(Trim(dtsModSheet.Cells(tempModuleResCnt,2)))&" = "&Cstr(Trim(dtsModSheet.Cells(tempModuleResCnt+1,2)))

tempModuleResCnt = tempModuleResCnt + 1

'msgbox "The Condition is "& Cstr(Trim(dtsModSheet.Cells(tempModuleResCnt,2)))&" = "&Cstr(Trim(dtsModSheet.Cells(tempModuleResCnt+1,2)))

'msgbox "Condition is true entering 2nd Do loop"

'msgbox tempModuleResCnt

modName = dtsModSheet.Cells(tempModuleResCnt,2)

testCaseCnt = testCaseCnt + 1

If Lcase(Cstr(Trim(dtsModSheet.Cells(tempModuleResCnt,4)))) = "pass" Then

passCnt = passCnt + 1

else

failCnt = failCnt + 1

End If

Loop While Cstr(Trim(dtsModSheet.Cells(tempModuleResCnt,2))) = Cstr(Trim(dtsModSheet.Cells(tempModuleResCnt+1,2)))

totalTestCases = totalTestCases + testCaseCnt

totalPassCnt = totalPassCnt + passCnt

totalFailCnt = totalFailCnt + failCnt

NewHighLevSheet.Cells(intHighLevResultCnt,2) = modName

NewHighLevSheet.Cells(intHighLevResultCnt,3) = testCaseCnt

NewHighLevSheet.Cells(intHighLevResultCnt,4) = passCnt

NewHighLevSheet.Cells(intHighLevResultCnt,5) = failCnt

NewHighLevSheet.Cells(intHighLevResultCnt,6) = ((passCnt/testCaseCnt)*100)&"%"

NewHighLevSheet.Range("F" & intHighLevResultCnt).Font.ColorIndex = 50

NewHighLevSheet.Range("F" & intHighLevResultCnt).Font.Bold = True

NewHighLevSheet.Cells(intHighLevResultCnt,7) = ((failCnt/testCaseCnt)*100)&"%"

NewHighLevSheet.Range("G" & intHighLevResultCnt).Font.ColorIndex = 3

NewHighLevSheet.Range("G" & intHighLevResultCnt).Font.Bold = True

'msgbox NewHighLevSheet.Cells(intHighLevResultCnt,2) &" "&NewHighLevSheet.Cells(intHighLevResultCnt,3)&" "&NewHighLevSheet.Cells(intHighLevResultCnt,4)&" "&NewHighLevSheet.Cells(intHighLevResultCnt,5)&" "& ((failCnt/testCaseCnt)*100)&"%"

intHighLevResultCnt = intHighLevResultCnt + 1

Wend

'msgbox "Total Cases "& totalTestCases &"Total Pass "& totalPassCnt &"Total Failed "& totalFailCnt

passPercent = ((totalPassCnt/totalTestCases)*100)

failPercent = ((totalFailCnt/totalTestCases)*100)

NewHighLevSheet.Cells(7,3) = totalTestCases

NewHighLevSheet.Cells(8,3) = totalPassCnt

NewHighLevSheet.Cells(9,3) = totalFailCnt

NewHighLevSheet.Cells(4,2) = Round(passPercent, 2) & " % of the Test Cases Passed"

NewHighLevSheet.Cells(5,3) = Round(failPercent, 2) & " % of the Test Cases Failed"

' Set dtsTempSheet = OpenSheet(resultFHand,"Report by Testcase")

' stepFailCnt = 0

' For i = 2 to dtsTempSheet.UsedRange.Rows.Count

' If Lcase(Cstr(Trim(dtsTempSheet.Cells(i,5).Text))) = "fail" Then

stepFailCnt = stepFailCnt +1

' End If

'Next

NewHighLevSheet.Cells(5,2) = stepFailCnt &" Errors Reported."

NewHighLevSheet.Range("A" & intResRowCnt & ":L" & intResRowCnt).Font.Size = 8

resultFHand.ActiveWorkbook.Save

End Function

---------------------------------------------

Open a Excel sheet and write the contents.

Excel functions

Public Function WriteToXls(ByVal strFilename, ByVal strColumn, ByVal iRow, ByVal strValue)

On Error Resume Next

Dim ExcelObj

Dim NewSheet

Dim colIndex

logger.LogInfo "WriteToXls start"

Set ExcelObj = CreateObject("Excel.Application")

ExcelObj.Visible = False

ExcelObj.DisplayAlerts = False

ExcelObj.Workbooks.Open strFilename

Set NewSheet = ExcelObj.Sheets.Item(1)

'Get Column index

colIndex = GetColumnIndex(NewSheet,strColumn)

'Adjust Row index

iRow = iRow + 1

'Fill value

NewSheet.Cells(iRow, colIndex).Value = CStr(strValue)

'Save the file

ExcelObj.ActiveWorkbook.Save

'Close the file

Excelobj.Quit

Set NewSheet = Nothing

Set Excelobj = Nothing

If Err.Number <> 0 Then

logger.LogError "WriteToXls " & Err.Number & " " & Err.Description

End If

logger.LogInfo "WriteToXls end"

Err.Clear

End Function

'######################################################################################################

'# Purpose: Gets the column indeex for the required column name in the specified param xls

'# Method: GetColumnIndex

'# Inputs: sheetHandle(Datatype XL sheet, object reference to XL sheet), strColumn (Datatype String, Name of

'# the column)

'######################################################################################################

Public Function GetColumnIndex(ByRef sheetHandle, ByVal strColumn)

On Error Resume Next

Dim i

logger.LogInfo "GetColumnIndex start"

GetColumnIndex = -1

For i = 1 To sheetHandle.UsedRange.Columns.count

If ucase(trim(sheetHandle.Cells(1,i).Text)) = ucase(trim(strColumn)) Then

GetColumnIndex = i

Exit For

End If

If Err.Number <> 0 Then

logger.LogError "GetColumnIndex " & Err.Number & " " & Err.Description

End If

logger.LogInfo "GetColumnIndex end"

End Function

'######################################################################################################

'# Purpose: Writes the given value to specified param xls file

'# Method: WriteToXlsColumnParams

'# Inputs: strFilename(Datatype String, Xls file name with path), strColumn (Datatype String, Name of

'# the column) , iRow (Datatype Integer, row number), strValue (Datatype String/Variant Value

'# to be written

'######################################################################################################

Public Function WriteToXlsColumnParams(ByVal strFilename, ByVal strRow, ByVal iCol, ByVal strValue)

On Error Resume Next

Dim ExcelObj

Dim NewSheet

Dim colIndex

logger.LogInfo "WriteToXlsColumnParams start"

Set ExcelObj = CreateObject("Excel.Application")

ExcelObj.Visible = False

ExcelObj.DisplayAlerts = False

ExcelObj.Workbooks.Open strFilename

Set NewSheet = ExcelObj.Sheets.Item(1)

'Get Column index

rowIndex = GetRowIndex(NewSheet,strRow)

'Adjust Row index

iCol = iCol + 1

'Fill value

NewSheet.Cells(rowIndex, iCol).Value = CStr(strValue)

'Save the file

ExcelObj.ActiveWorkbook.Save

'Close the file

Excelobj.Quit

Set NewSheet = Nothing

Set Excelobj = Nothing

If Err.Number <> 0 Then

logger.LogError "WriteToXlsColumnParams " & Err.Number & " " & Err.Description

End If

logger.LogInfo "WriteToXlsColumnParams end"

Err.Clear

End Function

'######################################################################################################

'# Purpose: Gets the row indeex for the required column name in the specified param xls

'# Method: GetRowIndex

'# Inputs: sheetHandle(Datatype XL sheet, object reference to XL sheet), strColumn (Datatype String, Name of

'# the column)

'######################################################################################################

Public Function GetRowIndex(ByRef sheetHandle, ByVal strRow)

On Error Resume Next

Dim i

logger.LogInfo "GetRowIndex start"

GetRowIndex = -1

For i = 1 To sheetHandle.UsedRange.Rows.count

If ucase(trim(sheetHandle.Cells(i,1).Text)) = ucase(trim(strRow)) Then

GetRowIndex = i

Exit For

End If

If Err.Number <> 0 Then

logger.LogError "GetRowIndex " & Err.Number & " " & Err.Description

End If

logger.LogInfo "GetRowIndex end"

End Function

2. Msgbox

msgbox "col index "&colIndex ‘will display col index 1

'Public function Writetoexcel (byval strfilename, byval rowno, byval colno, byval val, byval shetno)

'Set Excelobj = Createobject("Excel.Application")

'Excelobj.visible = True

'Excelobj.displayalerts = False

'Excelobj.Workbooks.open strfilename

'Set NewSheet = ExcelObj.Sheets.Item(shetno)

'For i=1 to rowno

' For j=1 to colno

' NewSheet.Cells(i, j).Value = CStr(val)

' msgbox "rowno "&rowno

' msgbox "colno "&colno

' msgbox "val "&val

' Next

'Next

' ExcelObj.ActiveWorkbook.Save

'End Function

'a = Writetoexcel ("C:\new.xls", 4, 4, "a" , 2)

'-------------------- display what is there in excel fro row 1 to row 2

'Public function Readfromexcel (byval strfilename, byval rowno, byval colno, byval shetno)

'Set Excelobj = Createobject("Excel.Application")

'Excelobj.visible = True

'Excelobj.displayalerts = False

'Excelobj.Workbooks.open strfilename

'Set NewSheet = ExcelObj.Sheets.Item(shetno)

'For i=1 to rowno

' For j=1 to colno

' val = NewSheet.Cells(i, j).Value

' msgbox "rowno "&i&"col no "&j&" " &val

''' msgbox "colno "&colno

''' msgbox "val "&val

' Next

'Next

' ExcelObj.ActiveWorkbook.Save

'End Function

'a = Readfromexcel ("C:\new.xls", 4, 4, 2)

--------------------------------

****************************************Library Details********************************************************

'* Library Name : Create Results Folder

'* Library Description : The library provides the Function to create the results folder to store

' the automation results. The function fetches the default path to create the results folder from 'Global Environment' Variable XML File Named as

' Global_Variables.xml, stored in the automation framework folder.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'* Type of Library : User Defined

'* User Defined Functions Used : Func_Create_Results_Folder

'* Number of Input Parameters : 0

'* Number of Output Parameters : 1

'* Name of Input Parameters : N/A

'* Name of Output Parameters : strFolderPath

'* Descritpion of Input Parameters : N/A

'* Descritpion of Output Parameters : The function returns the final results folder path.

'******************************Author, Creation & Modification Details*****************************************

'* Created By : Kalyan

'* Date Created : 14th April 2011

'* Called From (Action Name) : N/A

'* Last Updated By : Kalyan

'* Date Updated : 14th April 2011

'/*==========================================================================================================*\

Public Function Func_Create_Results_Folder

Dim strFolderPath

strTodaydate = Now()

strTodaydate = Replace(Replace(Replace(strTodaydate,"/",""),":","")," ","")

Set fso = CreateObject("Scripting.FilesystemObject")

strFolderPath = Environment.Value("strResultsFolderPath")&strTodaydate

fso.CreateFolder(strFolderPath)

Func_Create_Results_Folder=strFolderPath

End Function

'''**************************************************************************************************************************************************************************************************************

''<Procedure>

''<name> CreateHTMLReport</name>

''<description> This function creates the text log file based on current date as an input for html log file.</description>

''<param name="strHTMLFilePath">[in] The text file path which needs to be created and transformed into html file.</param>

''<returns> NIL</returns>

''<example>

'' strHTMLFilePath =strLogfilePath &"\HTML_Result_Log_"& Environment.Value("TestName") &"_TestSuite_"& dtMyDate & ".txt"

'' Call CreateHTMLReport(strHTMLFilePath)

''</example>

''<changelog>

'' Date Author Changes/Notes

''----------- ------------------ -----------------------

'' 28-Dec-2010 Kalyan Initial version.

''</changelog>

''</Procedure>

'''''*************************************************************************************************************************************************************************************************************

Public Sub CreateHTMLReport(strTextLogfilePath)

On Error Resume Next

Dim dtStartDateTime

Dim dtEndDateTime

Dim intHour, intMinute ,intSec , a

Dim fso

Const ForWriting = 2

a= "0"

intHour = Hour(Time)

intMinute = Minute(Time)

intSec = Second(Time)

If Len(intHour) < 2 Then

intHour = a & intHour

End If

If Len(intMinute) < 2 Then

intMinute = a & intMinute

End If

If Len(intSec) < 2 Then

intSec = a & intSec

End If

dtStartDateTime = Day(Date) &"-"& MonthName(Month(Date),3) &"-"& Year(Date)&", "& intHour &":"& intMinute &":"& intSec

Set fso = CreateObject ("Scripting.FileSystemObject")

If Not (fso.FileExists(strTextLogfilePath)) Then

fso.CreateTextFile strTextLogfilePath, True

Set objHTMLTextFile = fso.OpenTextFile(strTextLogfilePath, 2, True)

objHTMLTextFile.WriteLine "<html>"

objHTMLTextFile.WriteLine "<head>"

objHTMLTextFile.WriteLine "<style>"

objHTMLTextFile.WriteLine "td{"

objHTMLTextFile.WriteLine "border-color: black;"

objHTMLTextFile.WriteLine "font-size: 14;"

objHTMLTextFile.WriteLine "}"

objHTMLTextFile.WriteLine "thead{"

objHTMLTextFile.WriteLine "border-color: black;"

objHTMLTextFile.WriteLine "font-size: 14;"

objHTMLTextFile.WriteLine "font-weight: bold;"

objHTMLTextFile.WriteLine "text-align: center;"

objHTMLTextFile.WriteLine "}"

objHTMLTextFile.WriteLine ".resultSummary{"

objHTMLTextFile.WriteLine "border-color: black;"

objHTMLTextFile.WriteLine "font-size: 20;"

objHTMLTextFile.WriteLine "font-weight: bold;"

objHTMLTextFile.WriteLine "text-align: center;"

objHTMLTextFile.WriteLine "}"

objHTMLTextFile.WriteLine ".summaryTable{"

objHTMLTextFile.WriteLine "border-color: black;"

objHTMLTextFile.WriteLine "}"

objHTMLTextFile.WriteLine ".centerTd{"

objHTMLTextFile.WriteLine "text-align: center;"

objHTMLTextFile.WriteLine "}"

objHTMLTextFile.WriteLine "</style>"

objHTMLTextFile.WriteLine "</head>"

objHTMLTextFile.WriteLine "<body bgcolor=#99ccff >" ''''body Color "Sky Blue"

objHTMLTextFile.WriteLine "<h1 style="&chr(34)&"text-align:center"&chr(34)&"><b> Automation Tests Results</b></h1>"

objHTMLTextFile.WriteLine "<br />"

objHTMLTextFile.WriteLine "<table align=center" &" " &"border=1"&" " &" class=summaryTable"&">"

objHTMLTextFile.WriteLine "<thead><tr><td colspan=2" &" " &"align=center " &" " &" class=resultSummary"&"> Result Summary: </td></tr></thead>"

objHTMLTextFile.WriteLine "<tr><td>Execution Start Date and Time : </td><td>"& dtStartDateTime &"</td></tr>"

objHTMLTextFile.WriteLine "<tr><td>Execution End Date and Time : </td><td> EndDateTime </td></tr>"

objHTMLTextFile.WriteLine "<tr><td>Executed on Machine : </td><td>"& Environment.Value("LocalHostName") &"</td></tr>"

objHTMLTextFile.WriteLine "<tr><td>Test Name : </td><td>"& Environment.Value("TestName") &"</td></tr>"

objHTMLTextFile.WriteLine "<tr><td>Executed by : </td><td>"& Environment.Value("UserName") &"</td></tr>"

objHTMLTextFile.WriteLine "<tr><td>Number of Steps Executed : </td><td> subTotal </td></tr>"

objHTMLTextFile.WriteLine "<tr><td>Number of Steps Passed : </td><td> subPassed </td></tr>"

objHTMLTextFile.WriteLine "<tr><td>Number of Steps Failed : </td><td> subFailed </td></tr>"

objHTMLTextFile.WriteLine "</table>"

objHTMLTextFile.WriteLine "<hr />"

objHTMLTextFile.WriteLine "<h2 align=center>Result Description: </h2>"

objHTMLTextFile.WriteLine "<hr />"

objHTMLTextFile.WriteLine "<Table Border="&chr(34)&"1"&chr(34)&"cellpadding="&chr(34)&"10"&chr(34)&"bgcolor="&chr(34)&"#FFFFFF"&chr(34)&">"

objHTMLTextFile.WriteLine "<tr>"

objHTMLTextFile.WriteLine "</tr>"

objHTMLTextFile.WriteLine"<thead>"

objHTMLTextFile.WriteLine("<tr bgcolor=#99ffff height=2>")

objHTMLTextFile.WriteLine("<td width=200><p align=center >Action Name</p></td>")

objHTMLTextFile.WriteLine("<td width=200><p align=center >Step Name</p></td>")

objHTMLTextFile.WriteLine("<td width=200><p align=center >Step Description</p></td>")

objHTMLTextFile.WriteLine("<td width=200><p align=center >Expected Result</p></td>")

objHTMLTextFile.WriteLine("<td width=136><p align=center >Status</p></td>")

objHTMLTextFile.WriteLine("<td width=200><p align=center >Execution Time</p></td>")

objHTMLTextFile.WriteLine(" <td width=200><p align=center >Status Image Location</p></td>")

objHTMLTextFile.WriteLine("</tr>")

objHTMLTextFile.WriteLine"</thead>"

objHTMLTextFile.Close

End If

Set objHTMLTextFile = nothing

Set fso = nothing

End Sub

''''**************************************************************************************************************************************************************************************************************

''<Procedure>

''<name> FinishCreatingHTMLReport</name>

''<description> This function should be called at the end of teh suite, it converts teh text log file into html log file.</description>

''<param name="strLogfilePath">[in] Result folder path where the html log file needs to be created.</param>

''<returns> NIL</returns>

''<example>

'' Call FinishCreatingHTMLReport("D:\QTP_Pearson\test_html")

''</example>

''<changelog>

'' Date Author Changes/Notes

''----------- ------------------ -----------------------

'' 28-Dec-2010 Kalyan Initial version.

''</changelog>

''</Procedure>

Public Sub FinishCreatingHTMLReport(strLogfilePath)

''Public Sub FinishCreatingHTMLReport(strTextLogfilePath,strLogfilePath)

On Error Resume Next

Dim fso

Dim objHTMLTextFile

Dim strOldContents

Dim a, intHour, intMinute, intSec

Dim strMyDate, strTextLogfilePath, dtMyDate, strLineData

Dim arrLineData, intTotal , intPassed, intFailed

Dim strNewContents1,strNewContents2, strNewContents3, strNewContents4

Const ForReading = 1

Const ForWriting = 2

Const ForAppending = 8

strMyDate = Day(Date) &"_"& MonthName(Month(Date),3) &"_"& Year(Date)

strTextLogfilePath =strLogfilePath &"\HTML_Result_Log_"& Environment.Value("TestName") &"_TestSuite_"& strMyDate & ".txt"

dtMyDate = Day(Date) &"_"& MonthName(Month(Date),3) &"_"& Year(Date) &"-"& Hour(Time) &"_"& Minute(Time) &"_"& Second(Time)

Set fso = CreateObject ("Scripting.FileSystemObject")

If fso.FileExists(strTextLogfilePath) Then

If fso.FolderExists(strLogfilePath) Then

a = "0"

intHour = Hour(Time)

intMinute = Minute(Time)

intSec = Second(Time)

If Len(intHour) < 2 Then

intHour = a & intHour

End If

If Len(intMinute) < 2 Then

intMinute = a & intMinute

End If

If Len(intSec) < 2 Then

intSec = a & intSec

End If

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

intPassed= 0

intFailed= 0

Set objHTMLTextFile = fso.OpenTextFile(strTextLogfilePath,1)

Do Until objHTMLTextFile.AtEndOfStream = "True"

strLineData = Trim(objHTMLTextFile.ReadLine)

If strLineData <> "" Then

arrLineData = Split(strLineData," ")

For i = 0 To UBound(arrLineData)

If Trim(arrLineData(i)) ="Pass" Then

intPassed = intPassed+1

ElseIf Trim(arrLineData(i)) ="Fail" Then

intFailed = intFailed+1

End If

Loop

intTotal = intPassed+ intFailed

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

objHTMLTextFile.Close

dtEndDateTime = Day(Date) &"-"& MonthName(Month(Date),3) &"-"& Year(Date)&", "& intHour &":"& intMinute &":"& intSec

Set objHTMLTextFile = fso.OpenTextFile(strTextLogfilePath,1)

strOldContents = objHTMLTextFile.ReadAll

strNewContents1 = Replace(strOldContents, "EndDateTime",dtEndDateTime)

strNewContents2 =Replace(strNewContents1, "subTotal",intTotal)

strNewContents3 =Replace(strNewContents2, "subPassed",intPassed)

strNewContents4 =Replace(strNewContents3, "subFailed",intFailed)

objHTMLTextFile.Close

Set objHTMLTextFile = fso.OpenTextFile(strTextLogfilePath,2, True)

objHTMLTextFile.Write strNewContents4

objHTMLTextFile.Close

Set objHTMLTextFile = fso.OpenTextFile(strTextLogfilePath,8, True)

objHTMLTextFile.WriteLine "<tr>"

objHTMLTextFile.WriteLine "</tr>"

objHTMLTextFile.WriteLine "</Table>"

objHTMLTextFile.WriteLine "</body>"

objHTMLTextFile.WriteLine "</html>"

objHTMLTextFile.Close

fso.MoveFile strTextLogfilePath,strLogfilePath &"\HTML_Result_Log_"& Environment.Value("TestName") &"_TestSuite_"& dtMyDate & ".html"

SystemUtil.Run(strLogfilePath &"\HTML_Result_Log_"& Environment.Value("TestName") &"_TestSuite_"& dtMyDate & ".html")

Else

Reporter.ReportEvent micWarning, "FinishCreatingHTMLReport",strLogfilePath &" : Result folder path is invalid."

End If

Else

Reporter.ReportEvent micWarning, "FinishCreatingHTMLReport",strTextLogfilePath &": file path is invalid."

End If

Set fso = Nothing

End Sub

Public Sub InsertIntoHTMLReport(strStepName, strStepShortDesc, strExpectedResult, blnStatus, strLogfilePath,blnImage)

On Error Resume Next

Dim dtMyDate

Dim strHTMLFilePath

dtMyDate = Day(Date) &"_"& MonthName(Month(Date),3) &"_"& Year(Date)

strHTMLFilePath =strLogfilePath &"\HTML_Result_Log_"& Environment.Value("TestName") &"_TestSuite_"& dtMyDate & ".txt"

If strLogfilePath <> "" Then

Dim objFSO

Set objFSO = CreateObject("Scripting.FileSystemObject")

If (objFSO.FileExists(strHTMLFilePath)) Then

Call UpdateHTMLReport(strStepName, strStepShortDesc, strExpectedResult, blnStatus, strHTMLFilePath,strLogfilePath,blnImage)

Else

Call CreateHTMLReport(strHTMLFilePath)

Call UpdateHTMLReport (strStepName, strStepShortDesc, strExpectedResult, blnStatus, strHTMLFilePath,strLogfilePath,blnImage)

End If

Else

Reporter.ReportEvent micFail, "ERROR. Log file path is not specified", ""

End If

Set objFSO = Nothing

End Sub

''**************************************************************************************************************************************************************************************************************

''<Procedure>

''<name> UpdateHTMLReport</name>

''<description> This function updates the text log file as well as the QTP embeded Result log.</description>

''<param name="strStepName">[in] The calling function name or the Step name</param>

''<param name="strStepDesc">[in] Short Description of Step or calling function</param>

''<param name="strExpectedResult">[in] Expected Result description</param>

''<param name="blnStatus">[in] "True" for passed validation, "False" for failed validation</param>

''<param name="strHTMLFilePath">[in] The text file path which needs to be updated and transformed into html file.</param>

''<param name="strLogfilePath">[in] Result folder path where the html log file needs to be created</param>

'<param name="blnImage">[in] True or False , True if SnapShot is required , False if not required </param>

''<returns> NIL</returns>

''<example>

'' strHTMLFilePath =strLogfilePath &"\HTML_Result_Log_"& Environment.Value("TestName") &"_TestSuite_"& dtMyDate & ".txt"

'' Call UpdateHTMLReport( "Pearson Testing", "Testing Pearson Scenarios", "Automation Success", True, strHTMLFilePath,"D:\QTP_Pearson\test_html",True)

''</example>

''<changelog>

'' Date Author Changes/Notes

''----------- ------------------ -----------------------

'' 28-Dec-2010 Kalyan Initial version.

''</changelog>

''</Procedure>

Public Sub UpdateHTMLReport(strStepName, strStepDesc, strExpectedResult, blnStatus, strHTMLFilePath,strLogfilePath,blnImage)

On Error Resume Next

Dim dtMyDate

Dim qtApp

Dim strMyStatus

Dim strVarStatus

Dim strColor

Dim dtExecutionTime

Dim a, intHour , intMinute , intSec

Const ForWriting = 2

Const ForAppending = 8

dtMyDate = Day(Date) &"_"& MonthName(Month(Date),3) &"_"& Year(Date)

If UCase(Trim(blnStatus)) = Ucase("True") Then

strMyStatus = "Pass"

strColor ="GREEN"

Elseif UCase(Trim(blnStatus)) = Ucase("False") Then

strMyStatus = "Fail"

strColor ="RED"

End If

Set qtApp = CreateObject("QuickTest.Application")

strTimeStamp = Day(Date) & Month(Date) & Year(Date) &"_"& Hour(Time) & Minute(Time) & Second(Time)

If UCase(Trim(blnImage)) =UCase("True")Then

'' If blnStatus <> "True" Then

Dim strStatusFileName, strStatusFilePath,strStatusStepFilePath

strStatusFileName = "Execution_status_image_"& strTimeStamp & ".bmp"

strStatusFilePath = strLogfilePath & "\" & strStatusFileName

qtApp.Visible = False

Wait(1)

Desktop.CaptureBitmap strStatusFilePath, True

qtApp.Visible = True

strStatusStepFilePath = strStatusFilePath

'' Else

'' strStatusStepFilePath = "NA"

'' End If

ElseIf UCase(Trim(blnImage)) =UCase("False") Then

strStatusStepFilePath = "NA"

Else

Reporter.ReportEvent micWarning, "InsertIntoHTMLReport","blnImage parameter value: "& blnImage &" is not passed properly. Please pass boolean value."

Exit Sub

End If

a= "0"

intHour = Hour(Time)

intMinute = Minute(Time)

intSec = Second(Time)

If Len(intHour) < 2 Then

intHour = a & intHour

End If

If Len(intMinute) < 2 Then

intMinute = a & intMinute

End If

If Len(intSec) < 2 Then

intSec = a & intSec

End If

dtExecutionTime =Day(Date) &"-"& MonthName(Month(Date),3) &"-"& Year(Date)&", "& intHour &":"& intMinute &":"& intSec

Set fso = CreateObject ("Scripting.FileSystemObject")

Set objHTMLTextFile = fso.OpenTextFile(strHTMLFilePath, 8, true)

objHTMLTextFile.WriteLine("<tr>")

objHTMLTextFile.WriteLine("<td><font color=BLACK face=ARIAL>"& Environment.Value("ActionName") &"</font></td>")

objHTMLTextFile.WriteLine("<td><font color=BLACK face=ARIAL>"& strStepName &"</font></td>")

objHTMLTextFile.WriteLine("<td><font color=BLACK face=ARIAL>"& strStepDesc &"</font></td>")

objHTMLTextFile.WriteLine("<td><font color=BLACK face=ARIAL>"& strExpectedResult &"</font></td>")

objHTMLTextFile.WriteLine("<td ><font color=" & strColor &" face=ARIAL> "& strMyStatus &" </font></td>")

objHTMLTextFile.WriteLine("<td ><font color=BLACK face=ARIAL>"& dtExecutionTime &"</font></td>")

If strStatusStepFilePath ="NA" Then

objHTMLTextFile.WriteLine("<td ><font color=BLACK face=ARIAL>"& strStatusStepFilePath &"</font></td>")

Else

objHTMLTextFile.WriteLine("<td><font color=" & strColor &" face=ARIAL><a href='"& strStatusStepFilePath & "'>"& strStatusStepFilePath & "</a></font></td>")

End If

objHTMLTextFile.WriteLine("</tr>")

If strMyStatus = "Pass" Then

strVarStatus = micPass

Reporter.ReportEvent strVarStatus , strStepName , strStepDesc & ", Expected Result : <" & strExpectedResult &">.", strStatusStepFilePath

Elseif strMyStatus ="Fail" Then

strVarStatus = micFail

Reporter.ReportEvent strVarStatus , strStepName , strStepDesc & " , Expected Result : <" & strExpectedResult & ">.",strStatusStepFilePath

End If

objHTMLTextFile.Close

Set objHTMLTextFile = Nothing

Set qtApp = Nothing

Set fso = Nothing

End Sub

Search This Blog

Software Testing Material

QTP Framework:- Reporting function example

Popular posts from this blog

Online Selenium Training With Real Time Scenario

Online Tricentis Tosca Automation Training with Real Time Scenarios

Online Training for Manual/Functional