Function GetRootElementAttributeValueFromXML(sFileNameWithPath,sAttribute)
    ' Why we need to ADD 2 because each attribute followed by (=) and (")
	iLenOfValue=len(sAttribute) + 2
	Set doc = XMLUtil.CreateXML() 
	doc.LoadFile sFileNameWithPath 
	Set root = doc.GetRootElement() 
	If instr(1,root,sAttribute)  <= 0 then
		Reporter.ReportEvent micFail,sAttribute,"Not Found in XML file."
		exitrun(0)
	else	
		sStartPos=instr(1,root,sAttribute) + iLenOfValue
		sEndPos=instr(sStartPos,root,"""")
		GetRootElementAttributeValueFromXML=mid(root,sStartPos,sEndPos - sStartPos)
	end if
End Function

msgbox(GetRootElementAttributeValueFromXML("c:\temp\request.xml","MerchantId"))

Function PressKeyboardEnterButton(sWindowTitle)
	Set WshShell = CreateObject("WScript.Shell")
	WshShell.AppActivate sWindowTitle
	wait(1)
	WshShell.SendKeys "{ENTER}"
	wait(3)
End Function

Function GetEntireValueFromSpreadSheet(sFileNameWithPath,sSheetName)

		Dim fso, f
		Set fso = CreateObject("Scripting.FileSystemObject")
		sMsg="File Not Found"
		If fso.FileExists(sFileNameWithPath) = False then	   
			Reporter.ReportEvent micFail,sMsg, sFileNameWithPath
			ExitAction(0)
		end if

		Dim objExcel,objSheet,intRow,intcol
		' Declare Array
		Dim tmpArray()
		
		
		Set objExcel = CreateObject("Excel.Application")

		' Open the file
		objExcel.Workbooks.open sFileNameWithPath

		' Select the worksheet
		Set objSheet = objExcel.ActiveWorkbook.Worksheets(sSheetName)

		' Select the used range
		set r=objSheet.UsedRange
		'4 is for Last Row. Subtract -1 because FIRST row is a Heading
		iTotalRow=CInt(Split(r.Address, "$")(4)) - 1

		
		' Get the total column count
		iTotalCol= objSheet.Range("A1").CurrentRegion.Columns.Count

		' Resize the array
		ReDim tmpArray(iTotalRow,iTotalCol)


		' Need to subtract -1 because loop start with 0.
		For intRow= 0 to iTotalRow - 1
			' Need to subtract -1 because loop start with 0. For Column.
			For intcol=0 to iTotalCol - 1
				' Assign to an Array.				
				tmpArray(intRow,intcol) = trim(objSheet.Cells(intRow + 2,intcol + 1).value)
			Next
		Next
	
		' Quit Excel
		objExcel.DisplayAlerts = False
		objExcel.Quit		
		Set objExcel = Nothing
		Set objSheet = Nothing		
		

		GetEntireValueFromSpreadSheet=tmpArray
		
End Function

Function GetDataFromDatabase(sDatabaseName,sUID,sPWD,sSQL)	'Declare the array
	dim DbArray()
		
        TotalRow=GetRowsCountFromDatabase(sDatabaseName,sUID,sPWD,sSQL)
	'Create the connection string:			
	strConn="DRIVER={Microsoft ODBC for Oracle};SERVER=" & sDatabaseName & ";User ID=" & sUID & ";Password=" & sPWD & " ;"

	'Establish the connection:
	Set oConn = CreateObject("ADODB.Connection")
	'Server-side cursor
	oConn.CursorLocation = 2
	oConn.Open strConn
		
	'Create a recordset to hold the results
	Set rs = CreateObject("ADODB.Recordset")
	'Options for CursorType are:  0=Forward Only, 1=KeySet, 2=Dynamic, 3=Static (read-only)
	rs.CursorType = 3
	Set rs.ActiveConnection = oConn
	'Execute the query and put the results into the recordset
	rs.Open sSQL
				 
	NumberOfColumn=rs.fields.count

	' Verify record set is not null or empty
	if rs.RecordCount <= 0 then
		Reporter.ReportEvent micFail,"Data NOT FOUND for SQL:",sSQL
		ExitAction(0)
	end if

	' Resize the array
	ReDim DbArray(TotalRow,NumberOfColumn)
	
	i=0 
	j=0
	' Assign recordset to an Array
	Do While Not rs.eof
	  For j = 0 to NumberOfColumn - 1
		  DbArray(i,j)=rs.fields(j).value
	  Next
	  rs.MoveNext
	  i=i+1
	loop
		
	'Close the Recordset  
	rs.close
	' Clear the connection string
	Set strConn=nothing
	' Clear the connection to a database
	Set oConn=nothing
	GetDataFromDatabase=DbArray
			
End Function

Function VerifyDatabaseNameUidPwd(sDatabaseName,sUID,sPWD)

	'Create the connection string:
	strConn="DRIVER={Microsoft ODBC for Oracle};SERVER=" & sDatabaseName & ";User ID=" & sUID & ";Password=" & sPWD & " ;"
	'Establish the connection:
	Set oConn = CreateObject("ADODB.Connection")
	 'Server-side cursor
	oConn.CursorLocation = 2
	On Error Resume Next
	err.clear
	oConn.Open strConn
		
	if err.number <> 0 then
		if Instr(Err.Description,"TNS:could not resolve service name") > 0 then
			Call CreateUserDefineResultFile("Fail=> " & Environment("TestName"))				
			Reporter.ReportEvent micFail,"Either database is down or Database Name is incorrect", sDatabaseName
		end if
		if Instr(Err.Description,"invalid") > 0 then
			Call CreateUserDefineResultFile("Fail=> " & Environment("TestName"))				
			Reporter.ReportEvent micFail,"Invalid Database UserId/Password", sUID & "/" & sPWD
		end if

		Set strConn=nothing
		Set oConn=nothing
		ExitAction(0)
	end if
	Set strConn=nothing
	Set oConn=nothing
End Function

Function VerifyRowsColumnsEqualOfTwoDiemensionalArrays(arr1,arr2)

	' Verify number of ROWS are equal
	If  ubound(arr1,1) <> ubound(arr2,1) Then
		Reporter.ReportEvent micFail,"Number of ROWS not equal",ubound(arr1,1) & "<>" & ubound(arr2,1)
		ExitAction(0)
	End If

	' Verify number of COLUMNS are equal
	If  ubound(arr1,2) <> ubound(arr2,2) Then
		Reporter.ReportEvent micFail,"Number of COLUMNS not equal:", ubound(arr1,2) & "<>" & ubound(arr2,2)
		ExitAction(0)
	End If

End Function

 '**** Compare two arrays, the order of the data is not important ****


Function CompareArraysNotOrder (arrArray1, arrArray2)

   Dim intArray1, intArray2

   For intArray1 = 1 to UBound (arrArray1)
      For intArray2 = 1 to UBound (arrArray2)
         If arrArray1 (intArray1) = arrArray2 (intArray2) Then
	    arrArray1 (intArray1) = "MATCHED":  arrArray2 (intArray2) = "MATCHED"
	    Exit For
	End If
      Next
   Next

   CompareArraysNotOrder = True
   For intArray1 = 1 to UBound (arrArray1)
      If  arrArray1 (intArray1) <> "MATCHED" Then
	CompareArraysNotOrder = False
	Exit For
      End If
   Next

End Function

Function SaveFileViaInternetExplorer(sEntireFilePath,BrwTitle)
	
	Brw_Title=BrwTitle

	' This is descriptive programming
	sTitle="title:=" & Brw_Title & ".*"

	' Select 'File menu
	Browser(sTitle).WinToolbar("regexpwndclass:=ToolbarWindow32","location:=0").Press "&File"

	' Slect the the 'Save As' Submenu
	Browser(sTitle).WinMenu("menuobjtype:=3").Select "Save As..."

	' Enter the ENTIRE path of the file
	Browser(sTitle).Window("text:=Save As").WinObject("regexpwndclass:=RichEdit20W").Type(sEntireFilePath)

	' Select File Type
	Set WshShell = CreateObject("WScript.Shell")
	wait(2)

	WshShell.SendKeys "{TAB}"
	wait(2) 
	WshShell.SendKeys "{UP}"
	WshShell.SendKeys "{UP}"
	Window("text:=Save As").WinObject("regexpwndclass:=RichEdit20W").Type(micReturn)
	wait(2)

	' Select 'File menu
	Browser(sTitle).WinToolbar("regexpwndclass:=ToolbarWindow32","location:=0").Press "&File"

	' Slect the the 'Close' Submenu
	Browser(sTitle).WinMenu("menuobjtype:=3").Select "Close"
	wait(2)

End Function

Function VerifyItemExistsInWebList(vObject,sItem)
	bFound=False
	iTotalItem=vObject.GetROProperty("Items Count")
	For i = 1 to iTotalItem
		if vObject.GetItem(i) = sItem then
			bFound=True
			Exit for
		end if
	next
		
	If bFound=False Then
		Reporter.ReportEvent micFail,"Item NOT found:",sItem
		VerifyItemExistsInWebList="False"	
	End If
End Function

ieWin.Open               ‘create IE object and open a window
ieWin.Write “string 1”
   .
   .
   .
ieWin.Write “string X”
ieWin.Close              ‘close the window and terminate IE object

  
Sub GetIPAddress()
	Dim objShell, objExecObject, strLine, strIP 
	
	Set objShell = WScript.CreateObject("WScript.Shell")
	Set objExecObject = objShell.Exec("%comspec% /c ipconfig.exe")
	
	Do Until objExecObject.StdOut.AtEndOfStream
		strLine = objExecObject.StdOut.ReadLine()
		strIP = Instr(strLine,"Address")
		If strIP <> 0 Then
			Wscript.Echo strLine
		End If
	Loop
End Sub 

Sub CreateDesktopShortcut(strTargetPath, strLinkName, strDescription)
	Dim objShell, strDesktopFolder, objShortCut
	
	Set objShell     = WScript.CreateObject("WScript.Shell")
	strDesktopFolder = objShell.SpecialFolders("AllUsersDesktop")
	Set objShortCut  = objShell.CreateShortcut(strDesktopFolder & "\" & strLinkName)
	
	objShortCut.TargetPath  = strTargetPath
	objShortCut.Description = strDescription
	objShortCut.Save
End Sub

Function GetSystemVariable(strSysVar)

	Dim objWshShell, objWshProcessEnv
	
	Set objWshShell = CreateObject("WScript.Shell")
	Set objWshProcessEnv = objWshShell.Environment("Process")
	
	GetSystemVariable = objWshProcessEnv(strSysVar)
	
End Function

Function CheckIfServiceIsRunning(strServiceName)

	Dim objShell, boolStatus 
	Set objShell= CreateObject("Shell.Application")
	
	' Execute command
	boolStatus = objShell.IsServiceRunning(strServiceName) 

	CheckIfServiceIsRunning = boolStatus
End Function

Sub ExecuteDosCommand(strCommand)

	Dim objShell 
	Set objShell = CreateObject("WSCript.shell") 
	
	' Execute command
	objShell.run strCommand
	Set objShell = Nothing 

End Sub

Sub DeleteKeyFromRegistry(RegKey)
	Dim objSh

	Set objSh = CreateObject("WScript.Shell")
	objSh.RegDelete (RegKey)
End Sub

Function RunStoredProcedure(StoredProcedureName)
	sDatabaseName="ABC"
	sUID="xyz"
	sPWD="ABC_xyz"
   
	' Create the database object
	Set cm = CreateObject("ADODB.Command")
	' Activate the connection.
	cm.ActiveConnection = "DRIVER={Microsoft ODBC for Oracle}; " &_
	"SERVER=" & sDatabaseName & ";User ID=" & sUID & ";Password=" & sPWD & " ;"
	
	
	' Set the command type to Stored Procedures
	cm.CommandType = 4 ' Stored Procedures
	cm.CommandText = StoredProcedureName 
	
	' Define Parameters for the stored procedure
	cm.Parameters.Refresh
    	' Pass input value. Assuming Stored Procedure requires 2 parameters
	cm.Parameters(0).Value = "Prashant" 
	cm.Parameters(1).Value = "Patel" 
	
    	' Execute the stored procedure
	cm.Execute() 	
	Set cm = Nothing 

End Function

 

'Example of use ++++++++++++++++++++++++++++++++++++++++++++++++++++
'1.  Create Excel workbook "C:\Test.xls"
'2.  Create Worksheet with name "MyTestSheet"
'3.  At row one column A, type in "TestColumnOne"
'4.  At row one column B, type in "TestColumnTwo"
'5.  Fill in some data for the two columns
'6.  Close Excel
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Rules/Guidelines for Excel sheet
'
'1.  Don't use spaces in column headings
'2.  Don't use special characters (except underscore)
'3.  Don't use numeric characters
'4.  Keep column names unique
'5.  There is a limit on sheet name length, but I don't remember 
'    what it is
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Requires msexcl40.dll and QTP to utilize environment info
'Allows for letting Excel drive the test on a PC that doesn't have 
'Excel installed
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'Public Const

Public Const adUseClient = 3
Public Const adOpenKeyset = 1
Public Const adLockOptimistic = 3
Public Const adCmdText = 1
Public Const adOpenForwardOnly = 0
Public Const adLockReadOnly = 1
Public Const adOpenDynamic = 2

Dim adoRS
Dim strSQL

strSQL = "SELECT [TestColumnOne], [TestColumnTwo] FROM [MyTestSheet$]"

Set adoRS = ExecExcQry("C:\Test.xls",strSQL)

Do While Not adoRS.EOF
	'Process Some Code Here
	SetAllEnvVarsFromRS adoRS
	MsgBox "Col One Val : " & Environment("TestColumnOne") & "|||Col Two Val : " & Environment("TestColumnTwo")
	adoRS.MoveNext
Loop

Public Function GetExcConnStr(ExcWBFilePath)

   GetExcConnStr = "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & _
      ExcWBFilePath & ";ReadOnly=False"

End Function 

Public Function ExecExcQry(ExcelWBFilPth, ExcelSQL)

   Dim adoExcConn 'As ADODB.Connection
   Dim adoExcRS 'As ADODB.Recordset

   Dim strExcConn 'As String
         
   strExcConn = GetExcConnStr(ExcelWBFilPth)
   
   Set adoExcConn = CreateObject("ADODB.Connection")
   Set adoExcRS = CreateObject("ADODB.Recordset")
   
   With adoExcConn
      .ConnectionString = strExcConn
      .CursorLocation = adUseClient
      .Open
   End With
   
   adoExcRS.Open ExcelSQL, adoExcConn, adOpenKeyset, adLockOptimistic
   
   Set ExecExcQry = adoExcRS

End Function
Public Sub SetEnvVarToRSFldVal(EnvName, RSFldName, RSObject)

        If IsNull(RSObject.Fields(RSFldName).Value) Then
                Environment.Value(EnvName) = ""
        Else
                Environment.Value(EnvName) = RSObject.Fields(RSFldName).Value
        End If
        
End Sub
Public Sub SetAllEnvVarsFromRS(RecordSetObject)

	Dim adoField
	
	For Each adoField In RecordSetObject.Fields
		SetEnvVarToRSFldVal adoField.Name, adoField.Name, RecordSetObject
	Next
	Set adoField = Nothing
	
End Sub


 

 
Public Function FormatDate(Mydate,MyFormat)
	set oExcel = createobject("excel.application")
        FormatDate = oexcel.text(MyDate,MyFormat)
	Set OExcel = Nothing
End Function


 

Public Sub ClickJavaMenuItem(MenuPath)

	Dim strPathArr
	Dim strJavaCode

	Dim strItem
	
	strPathArr = Split(MenuPath,"|")
	strJavaCode = "JavaWindow(" & Chr(34) & "class description:=window" & Chr(34) & _
		"," & Chr(34) & "path:=TRexFrame;" & Chr(34) & ")"
	For Each strItem In strPathArr
		strJavaCode = strJavaCode & ".JavaMenu(" & Chr(34) & _
			"class description:=menu_item" & Chr(34) & "," & Chr(34) & _
			"label:=" & strItem & Chr(34) & ")"	
	Next
	strJavaCode = strJavaCode & ".Select"
	Execute strJavaCode
	
End Sub

  

Function CheckSortByOrder(arrList,Order) 

	Dim  itemIndex,itemsCnt,Flag,chkVal1,chkVal2,Item1,Item2,intBound
	
	For itemIndex = Lbound(arrList) To Ubound(arrList)-1
	'get item1 to check with
	Item1=arrList( itemIndex)
	'get item2 to compare with item1
	Item2=arrList(itemIndex+1)
		For intBound=1  to len(arrList( itemIndex))
			chkVal1=Left(Item1,intBound)
			'get the value to compare the sort
			chkVal2=Left(Item2,intBound)
			'check the sort
			If Not (StrComp(chkVal1,chkVal2) = 0) Then
				Select Case Order
			
				Case  "Ascending"

					If Right(chkVal1,1) < Right(chkVal2,1) Then
						blnFlag="True"
						Exit For
					Else
						blnFlag="False"
						CheckSortByOrder="UnSorted"
						Exit Function
					End If
				
				Case  "Decending"

					If Right(chkVal1,1) > Right(chkVal2,1) Then
						blnFlag="True"
						Exit For
					Else
						blnFlag="False"
						CheckSortByOrder="UnSorted"
						Exit Function
					End If
					
				End Select
			
			End If
		Next 
	Next
	If blnFlag= "True"  Then 
		CheckSortByOrder="Sorted"
	End If 
End Function

'******************************************************************************
'
' randArray(iMin, iMax)
'
' This function returns an array containing randomly order values between iMin 
' and iMax. For example if called with iMin=0 and iMax=2 an array with one of 
' the following value scrambles will be returned: (0,1,2) (0,2,1) (2,1,0), etc.
'
' Array values are unique and all values in the range of iMin and iMax are
' used. This function is very useful if you want to process an array of
' in a random sequence, rather than processing for 0 to ubound(). 
'
'
'******************************************************************************
'
'******************************************************************************
'
' scrambleArray(arIn)
'
' This function creates and returns a new array containing elements
' randomly reordered from the passed arIn array.
'
' This function is very useful if you want to process a Dictionary object
' in a random order, using the array of keys returned by the vbScript 
' Dictionary.Keys() method--in that situation call this function as follows:
'
'		myKeyArray = scrambleArray(myDictionary.Keys())
'
' The above line of code ensures that the myKeyArray is ordered
' differently and randomly each time that line of code is executed.
'
'******************************************************************************

        Dim reporterMode   : reporterMode=Reporter.Filter
        Dim errNum
'
        Reporter.Filter=rfDisableAll                'turn off QTP Results File logging
            On Error Resume Next                    'trap any exception
                Err.Clear
'
                'statement(s) to validate here...
'                
                errNum =Err.Number
            On Error Goto 0                         'return exception processing to QTP
        Reporter.Filter=reporterMode                'restore QTP Results File loggin
'            
        If NOT errNum=0 Then                        'exception occurred
'            
            'custom exception processing here...
'
        End If 

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'#Function Description: Converts an input date from one format and mask to a
'# new format and mask.  Currently, this function only
'# supports input dates with a 4-digit year.
'# Created By:	Michal Szapiel - Sogeti Automation
'#  Date Created:	08/30/2006
'# Required Parameters: in date_val - the input date to convert.
'#  in format_in - the format for specifying the order of
'#the month, day, and year in the input date.
'#in sMask_in - the character separating the month, day, and year
'#in the input date.
'#in format_out - the format for specifying the order and number
'#of digits to display for month, day, and year in
'#the output date.
'# in sMask_out - the character separating the month, day, and year
'#in the output date.
'#
'#Example: Date_ConvertFormat("04/05/2004", "MDY", "/", "YYYYMD", "-")
'#Example return value: "2004-4-5"
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Function Date_ConvertFormat(date_val, format_in, sMask_in, format_out, sMask_out)

	Dim newDate, months, days, years, temp_date, temp_value
	
	'# Parse the input date value into its three elements.
	temp_value = split(date_val, sMask_in, -1, 1)

	'# Set the month, day, and year from the input date value.
	Select Case format_in
		Case "MDY"
			months = temp_value(0)
			days = temp_value(1)
			years = temp_value(2)
			
		Case "DMY"
			days = temp_value(0)
			months = temp_value(1)
			years = temp_value(2)
			
		Case "YMD"
			years = temp_value(0)
			months = temp_value(1)
			days = temp_value(2)
    End Select
	
	'# Format the input date value with the specified output format and mask.
	Select Case format_out
		Case "MMDDYYYY"
			if Len(months) = 1 Then
				months = "0" & months
			End if
			if Len(days) = 1 Then
				days = "0" & days
			End If
			If Len(years) = 2 Then
				years = "20" & years
			End If
			newDate = months & sMask_out & days & sMask_out & years
			
		Case "MMDDYY"
			if Len(months) = 1 Then
				months = "0" & months
			End if
			if Len(days) = 1 Then
				days = "0" & days
			End if
			if Len(years) = 4 Then
				years = Right(years, 2)
			End if
			newDate = months & sMask_out & days & sMask_out & years
	
		case "MDYYYY"
			if (Left(months, 1) = "0") Then
				months = Right(months, 1)
			End if
			if (Left(days, 1) = "0") Then
				days = Right(days, 1)
			End If
			If Len(years) = 2 Then
				years = "20" & years
			End If
			newDate = months & sMask_out & days & sMask_out & years
		
		case "MDYY"
			if (Left(months, 1) = "0") Then
				months = Right(months, 1)
			End if
			if (Left(days, 1) = "0") Then
				days = Right(days, 1)
			End if
			if (Len(years) = 4) Then
				years = Right(years, 2)
			End if
			newDate = monthS & sMask_out & days & sMask_out & years
			
		case "YYYYMMDD"
			If Len(years) = 2 Then
				years = "20" & years
			End If
			if (Len(months) = 1) Then 
				months = "0" & months
			End if
			if (Len(days) = 1) Then 
				days = "0" & days
			End If
			newDate = years & sMask_out & months & sMask_out & days
		
		case "YYMMDD":
		   if (Len(months) = 1) Then
				months = "0" & months
			End if
			if (Len(days) = 1) Then
				days = "0" & days
			End if
			if (Len(years) = 4) Then 
				years = Right(years, 2)
			End if
			newDate = years & sMask_out & months & sMask_out & days
		
		case "YYYYMD":
			If Len(years) = 2 Then
				years = "20" & years
			End If
			if (Left(months, 1) = "0") Then
				months = Right(months, 1)
			End if
			if (Left(days, 1) = "0") Then
				days = Right(days, 1)
			End if
			newDate = years & sMask_out & months & sMask_out & days
	
		case "YYMD":
			if (Left(months, 1) = "0") Then
				months = Right(months, 1)
			End if
			if (Left(days, 1) = "0") Then 
				days = Right(days, 1)
			End if
			if (Len(years) = 4) Then
				years = Right(years, 2)
			End if
			newDate = years & sMask_out & months & sMask_out & days
        End Select

	Date_ConvertFormat = newDate

End Function   

Set excRange = objXL.ActiveSheet.Cells(2, 1)
lngRes = excRange.CopyFromRecordset(rs)