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.

Remove an attachment from QC Through QTP

Function RemoveAttachFromQC(File_Name)
    var_cnt= QCUtil.CurrentTest.Attachments.NewList(“”).count
    For i= 1 to var_cnt
        If   QCUtil.CurrentTest.Attachments.NewList(“”).Item(2).Name =File_Name Then
            Attachment = QCUtil.CurrentTest.Attachments.NewList(“”).Item(1).ID
           QCUtil.CurrentTest.Attachments.RemoveItem(Attachment)
        Else
           Reporter.ReportEvent micFail,"Delete failed","Please provide the valid filename with extention"
        End If
    Next
End Function

File_Name=”Test.txt” 
Call RemoveAttachFromQC(File_Name)

Upload a file as Attachments To QC

Function UpLoadAttachToQC(File_Path)

    Set ObjCurrentTest = QCUtil.CurrentTest.Attachments

    Set ObjAttch = ObjCurrentTest.AddItem(Null)
    ObjAttch.FileName = File_Path
    ObjAttch.Type = 1
    ObjAttch.Post
    ObjAttch.Refresh
End Function
 
File_Path=”D:\test.txt”
 
Call UpLoadAttachToQC(File_Path)