Capture password from email in outlook using QTP

Consider the message by auto sending "Password service" is as below 

Hi User, 

Please find the credentials below. 

User Name is: name597406 
New password is: KI7UJ6$x^3DIwul 

Note: Please change your password as soon as you login into your application 

Thanks & Regards, 
Admin 

Check the "From" field and note the Display name of the sender and let it be "Password Service" 

The code is as below

Dim olFolderInbox, iTotalMails, sSubject
olFolderInbox = 6 : sSubject = ""
 
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
 
'Create reference to Inbox Folder
Set oInbox = objNamespace.GetDefaultFolder(olFolderInbox)
 
'Find all items in the Inbox Folder
Set oAllMails = oInbox.Items
iTotalMails = oAllMails.Count
 
'Loop through the mail items
For i=1 to iTotalMails
  'Check if the mail is UnRead or not
    If oAllMails(i).UnRead = True Then
'        msgbox oAllMails(i).sendername
        If oAllMails(i).sendername="Password Service" then
            res=split(oAllMails(i).Body,"password is: ")
            res1=split(res(1),"Note:")
            msgbox res1(0)
            Exit for
        end if
    
    End If
Next

Automation object model in QTP (AOM)

Automation object model is nothing but structural representation of objects,methods and properties which are used to perform quicktest operations.Automation enables software packages to expose their unique features to scripting tools and other applications. You can use the QuickTest Professional Automation Object Model to write programs that automate your QuickTest operations.

QuickTest Professional is COM Server and its different methods and properties are exposed by its COM interface which can be accessed by other applications and scripting tools to control it from outside.

To create the automation object, we use “CreateObject” function. Once the object has been created, we can access all other objects, methods and properties of the QuickTest . CreateObject creates and returns the reference to an automation object.


You can write a script that modifies the test object description properties in the Object Identification dialog box and performs an update run on all tests in a specified file folder.

You can define your settings for a test in QuickTest, then click “Generate Script” in the Generate tab of the Test Settings dialog box to generate an automation script based on the current test settings. You can then apply those same settings automatically to multiple tests using the whole automation script or excerpts from the generated file.

Generating an automation script for QuickTest Professional options:

• Navigate to Tools > Options > General and click on the “Generate Scripts” buttons
• Navigate to File > Settings>Properties and click on the “Generate Scripts” buttons
• Navigate to Tools > Object Identification and click on the “Generate Scripts” buttons

Example:
Launch QTP, open an existing test and Run the Test and Store Run Results in Specified Folder:

Dim qtApp
Dim qtTest
Dim qtResultsOpt

'Create the QTP Application object
Set qtApp = CreateObject("QuickTest.Application")

'If QTP is notopen then open it
If  qtApp.launched <> True then

qtApp.Launch

End If

'Make the QuickTest application visible
qtApp.Visible = True

'Set QuickTest run options
qtApp.Options.Run.ImageCaptureForTestResults = "OnError"
qtApp.Options.Run.RunMode = "Fast"
qtApp.Options.Run.ViewResults = False

'Open the test in read-only mode
qtApp.Open "C:\Program Files\HP\QuickTest Professional\Tests\AOMExamp;e", True

'set run settings for the test
Set qtTest = qtApp.Test

'Instruct QuickTest to perform next step when error occurs
qtTest.Settings.Run.OnError = "NextStep"

'Create the Run Results Options object
Set qtResultsOpt = CreateObject("QuickTest.RunResultsOptions")

'Set the results location
qtResultsOpt.ResultsLocation = "D:\AOMTestResult"

' Run the test
qtTest.Run qtResultsOpt

'Check the results of the test run
MsgBox qtTest.LastRunResults.Status

'Close the test
qtTest.Close

'Close QTP
qtApp.quit

'Release Object
Set qtResultsOpt = nothing
Set qtTest = Nothing
Set qtApp = Nothing

HTML reports in QTP

To get html reports after every execution follow the below steps which is one time configuration

1. Open registry
Start > Run > Regedit and click enter

2. Registry will be opened

3. Navigate to HKEY_LOCAL_MACHINE\SOFTWARE\Mercury Interactive\QuickTest Professional\Logger\Media\Log

4. Change the active DWORD from 0 to 1.

5. Open QTP and run a test. After the execution, the HTML report will be generated and stored in the results folder with name "log"

Associating function library in QTP

Function library can be associated in design time or run-time depending on the framework used.

To associate the function library at design time

navigate to ‘File > Settings > Resources > Associate Function Library’ option in QTP. Click on '+' button and browse for the file and add it to the Test

To associate the function library at run time, you can use any of the following

1) Automation Object Model (AOM)

'Open QTP
Set objQTP = CreateObject("QuickTest.Application")
objQTP.Launch
objQTP.Visible = True

'Open a test
objQTP.Open "D:\Automation\Test1", False, False
Set objFL = objQTP.Test.Settings.Resources.Libraries

'check if it is already associated, else associate it
If objFL.Find("D:\Automation\FunctionLibrary.vbs") = -1 Then
  objFL.Add "D:\Automation\FunctionLibrary.vbs", 1
End

2) using ExecuteFile method.

ExecuteFile "D:\Automation\FunctionLibrary.vbs"

3) using LoadFunctionLibrary method.

LoadFunctionLibrary "D:\Automation\FunctionLibrary.vbs"

Create log file in QTP

Function LogintoFile(strCode, strMessage) Dim objFS Dim objFile Dim objFolder Dim strFileName Set objFS = CreateObject("Scripting.FileSystemObject") If Not objFS.FolderExists(objFS.GetAbsolutePathName(".") & "\log") Then Set objFolder = objFS.CreateFolder(objFS.GetAbsolutePathName(".") & "\log") End If strFileName = objFS.GetAbsolutePathName(".") & "\log\" & year(date) & month(date) & day(date) & ".log" Set objFile = objFS.OpenTextFile(strFileName, 8, True) On Error Resume Next objFile.Write Date & ", " & Time & ", " & strCode & ", " & strMessage & vbcrlf ' disable the on error statement On Error GoTo 0 objFile.Close Set objFS = Nothing End Function 'Function Calling : call LogintoFile("Fail","Invalid User Credentials")

Capture ToolTip from QTP

'for Web Elements
msgbox browser("browser").Page("pagename").WebElement("webelementname").Object.title

'for images
msgbox Browser("browser").Page("pagename").Image("imagename").GetROProperty("alt")

'for Links
x=Browser("browser").Page("page").Link("linkname").GetROProperty("OuterHtml")
temp=split(x,chr("34"))
ToolTip=temp(1)
msgbox ToolTip

Delete cookies using QTP

SystemUtil.Run "Control.exe","inetcpl.cpl"
Set objShell = CreateObject("Wscript.Shell")
Do Until delcookie = True
    delcookie = objShell.AppActivate("Internet Properties")
    Wait(1)
Loop
objShell.Sendkeys "%i"
Wait(1)
objShell.Sendkeys "{ENTER}"
Wait(1)
objShell.Sendkeys "%f"
Wait(1)
objShell.Sendkeys "%d"
Wait(1)
objShell.Sendkeys "{ENTER}"
Wait(4)
objShell.Sendkeys "{ENTER}"

Prevent system from locking while running QTP scripts

Use the below lines of code in a function that is called frequently

Example: If you have a function to report or function to start your test case etc

set WshShell=CreateObject("WScript.Shell")
WshShell.SendKeys ("^{HOME}")

Lock PC after suite execution

Set obj = CreateObject("WScript.Shell")
sCmnd = "%windir%\SYSTEM32\rundll32.exe user32.dll,LockWorkStation"
obj.Run sCmnd, 0, False

Post defect to QC

Set TDConnection = CreateObject("TDApiOle.TDConnection")
TDConnection.InitConnection "http://testdb/tdbin" 'DB URL
TDConnection.ConnectProject "projectname","username","password"
If TDConnection.Connected Then
 reporter.reportevent micPass,"Connection","Connection successful"
Else
 reporter.reportevent micFail,"Connection","Connection Failed"
End If
Set BugFactory = TDConnection.BugFactory
Set Bug = BugFactory.AddItem (Nothing)
Bug.Status = "New"
Bug.Summary = "Connecting to TD"
Bug.Priority = "4-Very High"
Bug.AssignedTo = "admin"
Bug.DetectedBy = "admin" 
Bug.Post

Mouse right click for context menu

The below code right clicks on a link in a page named “Document” and selects “CreateDocument” in the context menu. Each option in the menu belongs to WebElement class. 'set the path to an object Set pathObj = Browser(“objBrowserName”).Page(“objPageName”) 'Create an object of DeviceReplay class which helps us simulate mouse click operation Set deviceReplay = CreateObject(“Mercury.DeviceReplay”) 'Get the X-axis value of the link getX = pathObj.Link(“Document”).GetROProperty(“abs_x”) 'Get the Y-axis value of the link getY = pathObj.Link(“Document”).GetROProperty(“abs_y”) 'Simulates the right click operation over the link deviceReplay.MouseClick getX,getY,RIGHT_MOUSE_BUTTON 'Click on the “CreateDocument” option. pathObj.WebElement(“name:=CreateDocument”).Click Set deviceReplay = Nothing

Wait for a page to load

Public Function func_waitForPage(objectref)

   Dim strResult
   Dim intloopcounter
   strResult=False
   Set wshell = CreateObject("WScript.Shell")
   wShell.Sendkeys("^{HOME}")
   For intloopcounter = 1 to 3
    If objectref.Exist Then
    sub_VerifyErrorNumber "wait for page"
   strResult = True
   Exit For
    End If
   Next
 
   If strResult <> True Then
    func_waitForPage = False
 Else
  func_waitForPage = True
   End If
End Function

Close all browsers using QTP

Public Function func_closeBrowsers()

 Dim oBrowser 'to store browser object description

 'Create description object
 Set strOpenBrowser = Description.Create
 strOpenBrowser("creationtime").Value = 0
 
 'close all open browsers
 While Browser(strOpenBrowser).Exist(0)
    Browser(strOpenBrowser).Close
 Wend
 
 'verify  whether all the opened browsers are closed or not.
 If Browser(strOpenBrowser).Exist(0) = False Then
  func_closeBrowsers = True
  sub_reportSuccess "Close Browser", "All browsers are closed successfully"
 Else
  func_closeBrowsers = False
 End If
End Function 'End of 'closeBrowsers' function.

Convert date format

Public Function func_convertDateFormat(ByVal DateString, ByVal SourceFormat, ByVal ReqFormat)

 Dim strMonthVal ' to store the month value 
 Dim strDayVal ' to store the day value
 Dim strYearVal ' to store the year value
 Dim aTempVal ' to store the splitting date values in an array
 
 If Not IsEmpty(DateString) Then
 
    ' select the specified  source format 
    Select Case SourceFormat
 
     Case "MM-DD-YYYY"
      ' split and store the month,day and year values in variables 
      aTempVal  = Split(DateString, "-")
      'verify input date string whether it is in source format or not.
      If Ubound(aTempVal) = 2  Then
       strMonthVal = aTempVal (0)
       strDayVal = aTempVal (1)
       strYearVal = aTempVal (2)
      Else
     func_convertDateFormat = "ErrMsg: Input parameter DateString is not in specified source format"
    End If
 
     Case "YYYY-MM-DD"
      ' split and store the month,day and year values in variables 
      aTempVal  = Split(DateString, "-")
      'verify input date string whether it is in source format or not.
      If Ubound(aTempVal) = 2  Then
       strYearVal = aTempVal (0)
       strMonthVal = aTempVal (1)
       strDayVal = aTempVal (2)
    Else
     func_convertDateFormat = "ErrMsg: Input parameter DateString is not in specified source format"
    End If
 
   Case "MM/DD/YYYY"
    ' split and store the month,day and year values in variables 
    aTempVal  = Split(DateString, "/")
    'verify input date string whether it is in source format or not.
    If Ubound(aTempVal) = 2  Then
     strMonthVal = aTempVal (0)
     strDayVal = aTempVal (1)
     strYearVal = aTempVal (2)
    Else
     func_convertDateFormat = "ErrMsg: Input parameter DateString is not in specified source format"
    End If
 
   Case "YYYY/MM/DD"
    ' split and store the month,day and year values in variables 
    aTempVal  = Split(DateString, "/")
    'verify input date string whether it is in source format or not.
    If Ubound(aTempVal) = 2  Then
     strYearVal = aTempVal (0)
     strMonthVal = aTempVal (1)
     strDayVal = aTempVal (2)
    Else
     func_convertDateFormat = "ErrMsg: Input parameter DateString is not in specified source format"
    End If
 
   Case "DD/MM/YYYY"
    ' split and store the month,day and year values in variables 
    aTempVal  = Split(DateString, "/")
    'verify input date string whether it is in source format or not.
    If Ubound(aTempVal) = 2  Then
     strDayVal = aTempVal (0)
     strMonthVal = aTempVal (1)
     strYearVal = aTempVal (2)
    Else
     func_convertDateFormat = "ErrMsg: Input parameter DateString is not in specified source format"
    End If
 
   Case Else
    'returns false when sorce format is not in the specified list.
    func_convertDateFormat = "ErrMsg: Input parameter" & " " & SourceFormat & " " & "is not valid"
    Exit Function
    
  End Select
 
  ' select the specified  source format 
  Select Case ReqFormat
   ' Combine the month,day and year values in variables to get required format
   Case "MM-DD-YYYY"
    func_convertDateFormat = strMonthVal & "-" & strDayVal & "-" & strYearVal
   Case "YYYY-MM-DD"
    func_convertDateFormat = strYearVal  & "-" & strMonthVal & "-" & strDayVal
   Case "MM/DD/YYYY"
    func_convertDateFormat = strMonthVal & "/" & strDayVal & "/" & strYearVal
   Case "DD/MM/YYYY"
    func_convertDateFormat = strDayVal & "/" & strMonthVal & "/" & strYearVal
   Case "YYYY/MM/DD"
    func_convertDateFormat = strYearVal  & "/" & strMonthVal & "/" & strDayVal
   Case Else
    func_convertDateFormat = "ErrMsg: Input parameter" & " " & ReqFormat & " " & "is not valid"
    Exit Function
  End Select
 Else
  func_convertDateFormat = "ErrMsg: Input parameter" & " " & DateString & " " & "is not valid"
 End If

End Function

Register user func

Public function func_WebEditset(object,strValue)	
	strTempfieldname=Replace(Replace(object.ToString,"WebEdit",""),"_"," ")
	If  object.Exist  Then	 
		If  object.GetROProperty("disabled")=0 Then
			object.Set strValue
			func_WebEditset = True
		Else
			func_WebEditset= " field is disabled"
		End If
	Else
		func_WebEditset=" field is not Found"
	End If
End Function

RegisterUserFunc "WebEdit","Set","func_WebEditset",True

Finding a table from the webpage

The below function finds a table and sets the control to the table using the index.

Public Function  func_Find_Table_Index_Variable(objTable,introw,intcol,sCel_1_1_value,intStartIndex,blnExactMatch)
	Table_Index = intStartIndex
	cel_value = ""
	sCel_1_1_value=Trim(sCel_1_1_value)
    objTable.SetTOProperty "index", Table_Index
	Do
		If  objTable.Exist(0) =False  Then
			Exit Do
		End If
		cel_value =  Trim(objTable.GetCellData(introw,intcol))
		Table_Index = Table_Index+1
		objTable.SetTOProperty "Index", Table_Index
		If  objTable.Exist(0) =False  Then
			Exit Do
		End If
		If (blnExactMatch=False and Instr(Ucase(cel_value),ucase(sCel_1_1_value))>0 ) Or (blnExactMatch=True and Ucase(cel_value)=Ucase(sCel_1_1_value)  ) Then
			Exit Do
		End If
	Loop
	If (blnExactMatch=False and Instr(Ucase(cel_value),ucase(sCel_1_1_value))>0 )Or blnExactMatch=True and Ucase(cel_value)=Ucase(sCel_1_1_value)Then
		objTable.SetTOProperty "index", Table_Index-1
		func_Find_Table_Index_Variable = Table_Index-1
			Exit Function
	End If
	func_Find_Table_Index_Variable = False
End Function

Compare 2 arrays

Public Function func_Comparetwoarrays(aFirstArray,aSecondArray)

	Dim intRowVal     ' Incrementer
	Dim StrInputVal   ' Capture input Array details 
	Dim strFailureVal 'To capture failed array values.
	Dim strCapturedVal  'to store captured values.

   'verify whether input arrays are empty or not.
   If UBound(aFirstArray) <> -1 And UBound(aSecondArray) <> -1 Then

       'verify whether input arrays sizes are equal or not.
       If UBound(aFirstArray) = UBound(aSecondArray) Then
           'repeat loop untill last element in each array is verified.
           For intRowVal = 0 To UBound(aFirstArray)

               'converting each charated in text in to upper case.
               firstarrval = Ucase(Trim(aFirstArray(intRowVal)))
               secondarrval = Ucase(Trim(aSecondArray(intRowVal)))

               'removing spaces between the words in the text.
               firstarrval = Replace(firstarrval," ","")
               secondarrval = Replace(secondarrval," ","")
				If  Trim(firstarrval)<> "" and Trim(secondarrval)<>""Then
					' Compares the input array  values with captured array values 
					   If Instr(Trim(firstarrval),Trim(secondarrval)) > 0 or Instr(Trim(secondarrval),Trim(firstarrval)) > 0 Then
						   func_Comparetwoarrays = True
					   Else
							'captures the array values which are not matched.
							func_Comparetwoarrays = aFirstArray(intRowVal)&" , "&aSecondArray(intRowVal)
							Exit Function
						End If
				End If
               Next
        Else
            func_Comparetwoarrays = "Two arrays are different in size."
        End If
    Else
        func_Comparetwoarrays = "Input parameters are not Valid."
    End If

End Function ' End of 'Comparetwoarrays' function

Generate random dates

Public Function func_generate_RandomDates(NoofDates)
   Dim datesArray 'To capture generated dates in an array
   Dim intincrementer   'To store loop counter value.
   Dim intRandomnumber  'To store random number.
   Dim strtravelDateTime  'To store travel date.
   Dim strFirstDate   'To store first date.
   Dim astrDates    'To store dates.
   Dim strReturnval  'To store the return value
	
	strFirstDate = ""
	
	'verify whether input parameter is equal to null or zero.
	If NoofDates > 0 Then
	
	   'To get specified number of dates (after 90 to 180 days of current date) 
	   For intincrementer=0 To Cint(NoofDates)-1
	
		   'generates random number between 90 and  181
		   intRandomnumber = Int((91 * Rnd) + 90)               
		   'addes random number with current date to generate random date.
		   strtravelDateTime=Date + intRandomnumber
		   
		   If intincrementer > 0 Then
			   strFirstDate=Trim(strFirstDate & ". " & strtravelDateTime)
		   Else
				strFirstDate = strtravelDateTime
		   End If 
		Next
	
		'splits random dates
		datesArray=Split(strFirstDate,". ")
		
		' Call the function to sort the generated random dates
		astrDates = func_datesSorting(datesArray)
		
		' to verify for dates in sorting order
		If Instr(astrDates(0),"ErrMsg:") > 0 Then
			func_generate_RandomDates = "ErrMsg: Unable to get the dates in sorting order. Because," & " " & astrDates
		Else
			func_generate_RandomDates = astrDates
		End If
	Else
		'Return the failure message when input parameter is not valid
		func_generate_RandomDates = Array("ErrMsg: Input parameter Is Invalid")
	End If
End Function  'Enfd of 'generate_RandomDates' function 

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

Public Function func_datesSorting(strArray)

	Dim inti 'to store the increment value
	Dim blnSwitched 'to hold the value to switch
	Dim strTemp 'temparary variable
	
	If Not IsEmpty(strArray) AND  Ubound(strArray) <> -1 Then
	  
	   Do
		   blnSwitched =False
	
		   'loop to sort the dates in the array. 
		   For inti = 0 To Ubound(strArray)-1
			   'verify whether present date is greater than preveous date 
			   If CDate(strArray(inti)) > CDate(strArray( inti+1)) Then
				   strTemp = strArray(inti)
				   strArray( inti) = strArray( inti + 1)
				   strArray( inti + 1) = strTemp
				   blnSwitched = True
				End If
			Next
		Loop While blnSwitched
	
		'retuns sorted array.
		func_datesSorting = strArray
	Else
		func_datesSorting = Array("ErrMsg: Input Dates Array is empty.")
	End If
End Function

Close all browsers

Public Function func_closeBrowsers()

 Dim oBrowser 'to store browser object description

 'Create description object
 Set strOpenBrowser = Description.Create
 strOpenBrowser("creationtime").Value = 0
 
 'close all open browsers
 While Browser(strOpenBrowser).Exist(0)
    Browser(strOpenBrowser).Close
 Wend
 
 'verify  whether all the opened browsers are closed or not.
 If Browser(strOpenBrowser).Exist(0) = False Then
  func_closeBrowsers = True
  sub_reportSuccess "Close Browser", "All browsers are closed successfully"
 Else
  func_closeBrowsers = False
 End If
End Function 'End of 'closeBrowsers' function.

Set browser options

Public Sub sub_SetBrowserOptions()
  Dim objShell         'To store shell object
  Dim RegInvalidSiteCert    'To store registry key value for "warn about certificate address mismatch" option.
  Dim RegChangeBtwSecure  'To store registry key value for "warn if changing between secure and not secure mode" option.
  Dim RegAllowActiveContent 'To store registry key value for "Allow Active content to run in files on MyComputer" option.
  Dim RegDispMixedContent  'To store registry key value for "Display Mixed Content" option.
  
 'set the shell object reference.
 Set objShell = CreateObject("WScript.Shell")
 
 'to run next step when error occurred.
 On Error Resume Next
 
 'to capture "warn about certificate address mismatch" option path in Registry Editor.
 RegInvalidSiteCert = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\WarnonBadCertRecving"
 
 'to capture "warn if changing between secure and not secure mode" option path in Registry Editor.
 RegChangeBtwSecure = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\WarnOnZoneCrossing"
 
 'to capture "Allow Active content to run in files on MyComputer" option path in Registry Editor.
 RegAllowActiveContent = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_LOCALMACHINE_LOCKDOWN\iexplore.exe"
 
 'to capture "Display Mixed Content" option path in Registry Editor.
 RegDispMixedContent = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1609"
 
 'Uncheck "warn about certificate address mismatch" option
 objShell.RegWrite RegInvalidSiteCert,"0","REG_DWORD"
 
 'Uncheck "warn if changing between secure and not secure mode" option
 objShell.RegWrite RegChangeBtwSecure,"0","REG_DWORD"
 
 'Uncheck "Allow Active content to run in files on MyComputer" option.
 objShell.RegWrite RegAllowActiveContent,"0","REG_DWORD"
 
 'Uncheck "Display Mixed Content" option.
 objShell.RegWrite RegDispMixedContent,"0","REG_DWORD"
 
 'WScript.Quit 'To stop and exit from the script.
 
End Sub 'End of 'SetBrowserOptions' function.