Common Functions in QTP

1. Action Template
If you need any default Template to be loaded whenever you create a new Action, just follow these steps.
i. Design the template with all the statements and comments in a text file.
ii. Save the text file as "ActionTemplate.mst" to the "QuickTest Installation Folder" under \dat folder.
iii. Start QTP and whenever you create new Actions, you can find the template by default.2. Close QTP - Closing the QTP after Execution
Private Function CloseQTP()
   Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
   Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'QTPro.exe'")
   For Each objProcess in colProcess
   objProcess.Terminate()
   Next
   Set objWMIService = Nothing
   Set colProcess = Nothing
End Function3. Open Application
' Open a specified application
' Parameter: application - the application full name (including location)
'@Description Opens an application
'@Documentation Open the application.

Function OpenApp (application)
   systemUtil.Run application
End Function4. Add Test Results
' Add a Report.Event step to the Test Results
'Parameters:
' status - Step status (micPass, micFail, micDone or micWarning)
' StepName - Name of the intended step in the report (object name)
' details - Description of the report event
'@Description Reports an event to the Test Results
'@Documentation Report an event to the Test Results.

Public Function AddToTestResults (status, StepName, details)
   Reporter.ReportEvent status, StepName, details
End Function5. Verify Object Is Enabled
Public Function VerifyEnabled (obj)
   Dim enable_property
   'Get the enabled property from the test object
   enable_property = obj.GetROProperty("enabled")
   If enable_property <> 0 Then ' The value is True (anything but 0)
     Reporter.ReportEvent micPass, "VerifyEnabled Succeeded", "The test object is enabled"
     VerifyEnabled = True
   Else
     Reporter.ReportEvent micFail, "VerifyEnabled Failed", "The test object is NOT enabled"
     VerifyEnabled = False
   End If
End Function6. Verify Object Is Disabled
Public Function VerifyDisabled (obj)
   Dim enable_property
   'Get the enabled property from the test object
   enable_property = obj.GetROProperty("disabled")
   If enable_property = 0 Then ' The value is False (0) - Enabled
     Reporter.ReportEvent micPass, "VerifyDisabled Succeeded", "The test object is enabled"
     VerifyDisabled = True
   Else
     Reporter.ReportEvent micFail, "VerifyDisabled Failed", "The test object is NOT enabled"
     VerifyDisabled = False
   End If
End Function7. Get Value Property
' Return the object 'Value' property
'@Description Returns the Object value
'@Documentation Return the 'Test object name' 'test object type' value.

Public Function GetValueProperty (obj)
   GetValueProperty = obj.GetROProperty("value")
End Function8. Get Text Property
' Return the object 'Text' property
'@Description Returns the Object value
'@Documentation Return the 'Test object name' 'test object type' value.

Public Function GetTextProperty (obj)
   GetTextProperty = obj.GetROProperty("text")
End Function9. Get Selection Property
' Return the object 'selection' property
'@Description Returns the Object value
'@Documentation Return the 'Test object name' 'test object type' value.

Public Function GetSelectionProperty (obj)
   GetSelectionProperty = obj.GetROProperty("selection")
End Function10. Get Checked Property
' Return the object 'checked' property
'@Description Returns the Object value
'@Documentation Return the 'Test object name' 'test object type' value.

Public Function GetCheckedProperty (obj)
   GetCheckedProperty = obj.GetROProperty("checked")
End Function11. Getting Number from String
Function extract_number(msg)
   Dim re, matches, item, result
   Set re = New RegExp
   re.pattern = "[A-Za-z -.]*(\d+).*"
   Set matches = re.Execute(msg)
   If matches.Count > 0 Then
      Set item = matches(0)
      If item.SubMatches.Count > 0 Then
         result = item.SubMatches(0)
      Else
         result = -1
      End If
   Else
           result = -1
   End If
   extract_number = result
End Function
MsgBox extract_number("This user belongs to 10 groups")12. Close All the opened Browsers Except QC opened browser
Function CloseBrowsers()
On Error Resume Next
Dim intWndCnt
Dim oDesc, oWnd
'Create Object description
Set oDesc = Description.Create '
Set oWnd = Desktop.ChildObjects(oDesc)
intWndCnt = oWnd.Count
For i = 0 to intWndCnt - 1
Set TmpObj = oWnd.item(i)
strTmpTitle = oWnd.item(i).GetROProperty("Text")
If instr(1,strTmpTitle, "Microsoft Internet Explorer",1) > 0 Then
   If instr(1,strTmpTitle, "Mercury Quality Center",1) > 0 Then
       'msgbox "Title :" & oWnd.item(i).GetROProperty("Text")
   Else
       'msgbox "Close :" & oWnd.item(i).GetROProperty("Text")
       oWnd.item(i).close
   End if
End If
Next
'Clean up
Set oDesc = nothing
Set oWnd = nothing
End Function13. Close all opened Excel files
Public Function fn_close_all_excel_files()
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'EXCEL.EXE'")
For Each objProcess in colProcessList
   objProcess.Terminate()
Next
End Function14. Excel sheet column count
Public Function dtGetColCount (sSheetName)
   On Error Resume Next
   Do
   i = i + 1
   sColName = DataTable.GetSheet(sSheetName).GetParameter(i).Name
   Loop While 0 = Err.Number
   'GetParameter throws an error when using an index that is out of bounds ...
   'We can use this functionality to ASSUME that it's an unused column.
   'We've come to the end of our USED columns
   dtGetColCount = i - 1
   On Error GoTo 0
End Function15. Create Dynamic Array
For i = 0 to 20
   Redim Preserve arrFileLines(i)
   arrFileLines(i) = "test" & i
Next16. Close Dialog box Autmatically
Function DialogClose (obj)
If obj.Dialog("nativeclass:=#32770").Exist(0) Then
   obj.Dialog("nativeclass:=#32770").WinButton("nativeclass:=Button","index:=0").Click
End If
RegisterUserFunc "Browser", "DialogClose", "DialogClose"
End Function17. Create Dynamic Value
iDynamicValue = now
iDynamicValue = replace(iDynamicValue,"/","")
iDynamicValue = replace(iDynamicValue,":","")
iDynamicValue = replace(iDynamicValue," ","")
iDynamicValue = replace(iDynamicValue,"PM","")
iDynamicValue = replace(iDynamicValue,"AM","")
msgbox iDynamicValue18. Get QTP file path
Set qtApp = CreateObject("QuickTest.Application") ' Create the Application objectqtpApp.Test.Location
TestLoc = qtApp.Test.Location
MsgBox TestLoc19. IS QC Connected?
Set qtApp = CreateObject("QuickTest.Application")
If qtApp.TDConnection.IsConnected Then
   msgbox "QC"
Else
   msgbox "Local"
End If

(or)

if QCUtil.IsConnected then
   Reporter.ReportEvent 0, "Connected", "Connected to server: " + QCUtil.QCConnection.ServerName + chr (13) +"Project: " +
   QCUtil.QCConnection.ProjectName + chr (13) + "Domain: " + QCUtil.QCConnection.DomainName
else
   Reporter.ReportEvent 1, "Not connected", "Not connected to Quality Center"
end if20. Keyboard Key Press through QTP Script
'Create Shell Object
Set WshShell = CreateObject("WScript.Shell")
'Send any Functinal Keys
' ALT = %
' F4 = {F4}
WshShell.SendKeys "%{F4}"
' Set shell object to Null
Set WshShell=nothing21. BEEP from QTP
' Three methods of issuing a BEEP from QTP

' Method 1
Extern.Declare micLong,"MessageBeep","User32","MessageBeep",micLong
retVal = Extern.MessageBeep(&HFFFFFFFF)
MsgBox retVal 'The return value should be 1.

' Method 2
Err.Number = 0
On Error Resume Next
Extern.Declare micLong,"MessageBeep","User32","MessageBeep",micLong
Extern.MessageBeep(&HFFFFFFFF)
If (Err.Number <> 0) Then
MsgBox Err.Description
End If

' Method 3
Extern.Declare micLong,"Beep","Kernel32","Beep",micLong,micLong
retVal = Extern.Beep(1000,250) 'The first number is frequency the second is duration.22. Check for Required URL
startURL = "www.google.com" ' Amend this to your required URL

' If no browser open, open browser and navigate to required URL
If Not Browser("CreationTime:=0").Exist Then
   Call launch(startURL)
Else

' Get the URL of the current open browser
currentURL=Browser("CreationTime:=0").GetROProperty("OpenURL")
' If not correct URL navigate to required URL
If Not currentURL = "www.google.com" Then
   Call launch(startURL)
End If
End If

Function launch(startURL)
 ' Create IE object and navigate
 ' to required URL
 set IE = CreateObject("InternetExplorer.Application")
 IE.Visible = true
 IE.Navigate startURL
End function23. Enable Doubleclick Event in QTP
Enable the ondblclick event in the Web Event Recording Configuration
  
To enable special event handling, use the Web Event Recording Configuration utility.   
1. Go to Tools -> Web Event Recording Configuration.   
2. Click .   
3. Expand the Standard Objects branch.   
4. Select the object you want to configure.   
5. Go to Event -> Add -> ondblclick. The event will be added to the list on the right.   
6. Select "If Handler" in the Listen column.   
7. Select "Enabled" in the Record column.   
8. Click to close the dialogs.24. Can I change the Active Screen which is shown on every new test?
You can change the Active Screen to any valid HTML page. The page can be located either locally or on the network.
For example, if you want your entire organization to view the same Active Screen when opening QuickTest Professional, open the NewTest.inf file located in QuickTest Professional\dat\SnapShots folder and add the following line: 
FileName1= "any full path to an HTML file"
For example:
FileName1=\mercury\public\MainPage.html25. How can I configure the report to show only errors by default?
You can configure the report to show only errors by default by adding the following section to the QTReport.ini file in your QuickTest Professional\bin folder.

[FilterDialog]
ReportAppDefaultFilter=1 # for error only
ReportAppDefaultFilter=3 # shows all messages (default)26. How do I make the test prompt the user for input while it is running?
The VBScript InputBox function enables you to display a dialog box that prompts the user for input and then continues running the test. You can use the value that was entered by the user later in the test. For more information on the InputBox function, refer to the VBScript Reference.

The following example shows the InputBox function used to prompt the user for a password.
Browser("Mercury Tours").Page("Mercury Tours").WebEdit("username").Set "administrator"
Passwd = InputBox ("Enter password", "User Input")
Browser("Mercury Tours").Page("Mercury Tours").WebEdit("password").Set Passwd27. How can I record on nonstandard menus?
You can modify how QuickTest behaves when it records menus.
The options that control this behavior are located in the Advanced Windows Applications Options dialog box.
(Tools > Options > Windows Applications > Advanced).28. Copy and Paste data from Clipboard during a test run
You can use the Clipboard object to copy, cut, and paste text during a QuickTest test run.
The object has the same methods as the Clipboard object available in Visual Basic:
Clear
GetData
GetFormat
GetText
SetData
SetText
Below is an example of Clipboard object usage:

Set MyClipboard = CreateObject("Mercury.Clipboard")
MyClipboard.Clear
MyClipboard.SetText "TEST"
MsgBox MyClipboard.GetText29. How do I close QuickTest after "n" test runs when running from Quality Center?
When running multiple QuickTest tests from Quality Center, you can specify that you want to close QuickTest after a specified number of tests are executed.

To do so, add the following lines to the end of the mic.ini file, located in your QuickTest Professional\bin folder:
[RemoteAgent]
CloseToolAfterRuns= (number)30. Adding Defects to Quality Center Automatically
Connects to Quality Center (TestDirector) from a QuickTest test and adds a bug to the database.

Dim TDConnection
Set TDConnection = CreateObject("TDApiOle.TDConnection")
TDConnection.InitConnection "http://yovav/tdbin" ' URL for the DB
TDConnection.ConnectProject "TD76","bella","pino" ' Valid login information
If TDConnection.Connected Then
MsgBox("Connected to " + chr (13) + "Server " + TDConnection.ServerName _
+ chr (13) +"Project " + TDConnection.ProjectName )
Else
MsgBox("Not Connected")
End If
'Get the IBugFactory
Set BugFactory = TDConnection.BugFactory
'Add a new empty bug
Set Bug = BugFactory.AddItem (Nothing)
'Fill the bug with relevant parameters
Bug.Status = "New"
Bug.Summary = "Connecting to TD"
Bug.Priority = "4-Very High" ' depends on the DB
Bug.AssignedTo = "admin" ' user that must exist in the DB's users list
Bug.DetectedBy = "admin" ' user that must exist in the DB's users list
'Post the bug to database (commit)
Bug.Post31. Create the file with option to use your own sxlt file
Sub CreateXML(Ofilename, Oxsltfilename, Orootnode,Ousexslt)
    'example logfile name "D:\Documents and Settings\ade\Desktop\errors.xml"
    'Const sLogFile = Ofilename
    Dim oFS
    Set oFS = CreateObject("Scripting.FileSystemObject")
    Dim oTextStream
    Set oTextStream = oFS.OpenTextFile(Ofilename,8,True) ' Open file in {8 = append mode}
    'Initalise xml lines
    oTextStream.WriteLine("")
    If Ousexslt = "true" Then
        oTextStream.WriteLine("")
    End If
    oTextStream.WriteLine("")
    oTextStream.WriteLine("<" & Orootnode & ">")
    oTextStream.Close
    Set oFS = Nothing
    Set oTextStream = Nothing
End Sub

Call WriteBlankNode("D:\errors.xml" ,"")32. Copy and Paste data from Clipboard during a test run
Function DialogClose (obj) 
If obj.Dialog("nativeclass:=#32770").Exist(0) Then
    obj.Dialog("nativeclass:=#32770").WinButton("nativeclass:=Button","index:=0").Click
End If
End Function

RegisterUserFunc "Browser", "DialogClose", "DialogClose"33. Getting the QTP File Path
Set qtApp = CreateObject("QuickTest.Application") ' Create the Application objectqtpApp.Test.Location
TestLoc = qtApp.Test.Location
MsgBox TestLoc34. Recovery Count
The following example uses the Count property to return the number of recovery scenarios associated with the current test and then use this information to perform various operations on the scenarios.

msgbox Recovery.Count,, "Number of Recovery Scenarios"
msgbox Recovery,, "Is Recovery enabled?"
For Iter = 1 to Recovery.Count
    Recovery.GetScenarioName Iter, ScenarioFile, ScenarioName
    Position = Recovery.GetScenarioPosition( ScenarioFile, ScenarioName )
    msgbox Recovery.GetScenarioStatus( Position ),, "Is scenario " & _
    ScenarioName & " from " & ScenarioFile & " enabled ?"
    ScenarioFile = Empty
    ScenarioName = Empty
Next35. Run Stored Procedure through QTP
Public Function sqlRunStoredProcedure (sSProcName, sParameter1, sParameter2, sParameter3)     ' Create the database object
    Set oADO_CMD = CreateObject("ADODB.Command")
    'Get connection string
    sConnectionStr = Environment("SQL_ConnectionStr")
    ' Activate the connection
    oADO_CMD.ActiveConnection = sConnectionStr
    ' Set the command type to Stored Procedures
    oADO_CMD.CommandType = 4
    oADO_CMD.CommandText = sSProcName
    ' Define Parameters for the stored procedure
    oADO_CMD.Parameters.Refresh
    ' The order of input output values is the same order as defined in the stored procedure
    'Based on the qty of parameters (if any) for this sproc ...
    'This maps to the [optional] aspect of the function - not all sprocs have parameters.
    'Note - in the ADO object model / Parameters collection (0) is reserved for the return value; the first parameter therefore is (1).
    If "" <> sParameter1 Then
    ' Pass FIRST input value [optional]
    oADO_CMD.Parameters(1).Value = sParameter1
    'msgbox oADOConnection.Parameters(1).Name +vbcr+ oADOConnection.Parameters(1).Value 'DEBUG
    If "" <> sParameter2 Then
    ' Pass SECOND input value [optional]
    oADO_CMD.Parameters(2).Value = sParameter2
    'msgbox oADOConnection.Parameters(2).Name +vbcr+ oADOConnection.Parameters(2).Value 'DEBUG
    If "" <> sParameter3 Then
    ' Pass THIRD input value [optional]
    oADO_CMD.Parameters(3).Value = sParameter3
    'msgbox oADOConnection.Parameters(3).Name +vbcr+ oADOConnection.Parameters(3).Value 'DEBUG
    End If
    End If
    End If
    ' Execute the stored procedure
    oADO_CMD.Execute()
    'Clean up objects
    Set oADO_CMD = Nothing
End Function36. Getting Runtime Browser Title
Function GetBrowserHandle(MyDomain)     ' Create IE object and navigate
    ' to required URL
    set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.Navigate MyDomain
    GetBrowserHandle = IE.HWND
End Function
browserHwnd = GetBrowserHandle(MyDomain)
set oBrowse = Browser("HWND:=" & browserHwnd)
PageTitle = oBrowse.GetROProperty("title")
Msgbox PageTitle37. Schedule Script Execution through VBS file
We need to invoke the Quicktest Professional script with the help of Automation object model. Here we prepare a code that invoke Quicktest Professional run the script and closes QTP. In our scenario I have created a VBS file that will open QTP and will run the script. You just save the attached VBS file on you machine and perform the following below steps.

Goto Start | Settings | Contrl Panel | Scheduled Tasks | Add Scheduled task. Here click onto "Next" and then click onto the browse button. Now locate the VBS file which we created earlier.

Now, under "perform this task" select "daily" and click "next". Now set the start time and after clicking next enter the password for you machine and finally click finish.

Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
qtApp.launch
qtApp.visible=true
qtApp.open "R:\slwhaley\qtp\IsoIntegrater"
qtApp.test.run
qtApp.test.close
qtAPP.TEST.exit
set qtApp= Nothing
ObjRecordset.Open 'This will execute your Query
If ObjRecordset.recordcount>0 then
  Field1 = ObjRecordset("Field1").Value
  Field2 = ObjRecordset("Field2").Value
End if38. Taking Backup of the scripts to Server
Const cOverWriteFiles = True
Dim xFound
xFound = False
' Verify whether the X: drive is already mapped
Set objNet = Wscript.CreateObject ("Wscript.Network")
Set colDrives = objNet.EnumNetworkDrives
For i = 0 To colDrives.count-1 Step 2
If colDrives.Item(i) = "X:" Then
xFound = True
End If
Next
' Map the X: Drive if not exist
If xFound = False Then
objNet.MApNetworkDrive "X:", "\\lon-otp-des-070\c$"
End If
Set objNet = Nothing
' Delete the backup
Set obj = CreateObject ("Scripting.FileSystemObject")
obj.DeleteFolder("X:\QT Scripts")
' Create new backup
obj.CopyFolder "C:\QT Scripts" , "X:\" , cOverWriteFiles39. Sending a e-mail through Outlook
Public Function MS_OutLook_SendMail(SendTo, Subject, Body, Attachment)
    'On Error Resume Next
    Dim ol, Mail
    Set ol=CreateObject("Outlook.Application")
    Set Mail=ol.CreateItem(0)
    Mail.to=SendTo
    Mail.Subject=Subject
    Mail.Body=Body
    If (Attachment <> "") Then
        Mail.Attachments.Add(Attachment)
    End If
    Mail.Display ' Display e-mail message window
    Window("regexpwndtitle:=Message.*").Activate ' Activate e-mail message window
    Window("regexpwndtitle:=Message.*").Type micAltDwn + "s" + micAltUp ' Simulate alt-s keypress to send e-mail
    'On Error GoTo 0
    Set Mail = Nothing
    Set ol = Nothing
End Function

MS_OutLook_SendMail "konkaravi_krishna@gmail.com", "test", "QTP Testing","C:\myfile.txt"40. How to send a mail through Lotus Notes using VBS
' Function: Send a Mail using Lotus Notes
Sub SendNotesMail(Subject , Attachment , Recipient , BodyText , SaveIt )
    'Set up the objects required for Automation into lotus notes
    Dim Maildb 'The mail database
    Dim UserName 'The current users notes name
    Dim MailDbName 'THe current users notes mail database name
    Dim MailDoc 'The mail document itself
    Dim AttachME 'The attachment richtextfile object
    Dim Session 'The notes session
    Dim EmbedObj 'The embedded object (Attachment)
    'Start a session to notes
    Set Session = CreateObject("Notes.NotesSession")
    'Get the sessions username and then calculate the mail file name
    'You may or may not need this as for MailDBname with some systems you
    'can pass an empty string
    UserName = Session.UserName
    MailDbName = Left(UserName, 1) & Right(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GETDATABASE("", MailDbName)
    'Set Maildb = Session.GETDATABASE("", "mail.box")
    If Maildb.ISOPEN = True Then
    'Already open for mail
    Else
    Maildb.OPENMAIL
    End If
    'Set up the new mail document
    Set MailDoc = Maildb.CREATEDOCUMENT
    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.Subject = Subject
    MailDoc.Body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    'Set up the embedded object and attachment and attach it
    If Attachment <> "" Then
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
    Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
    'MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
    'Send the document
    MailDoc.SEND 0, Recipient
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub 

Call SendNotesMail( "this is a test subject" , "C:\Temp\NotesSendMail.vbs" , "XYZ /fr/socgen","my message" , True)