for more QTP scripts, www.ramupalanki.

com

QTP Script 33 - How to compare two excel sheets of the same excel workbook and highlight the
cells with different values in the first sheet?
Excel object is being created here
Set Exl_Obj = CreateObject("Excel.Application")
Exl_Obj.Visible = True
File sac1 is being opened
Set WB_Obj_1= Exl_Obj.Workbooks.Open("C:\sac1.xls")
Cells in the first and second sheet of sac1 are compared
Set WS_Obj_1= WB_Obj_1.Worksheets(1)
Set WS_Obj_2= WB_Obj_1.Worksheets(2)
  For Each cell In WS_Obj_1.UsedRange
If cell.Value <> WS_Obj_2.Range(cell.Address).Value Then
cell.Interior.ColorIndex = 6
Else
cell.Interior.ColorIndex = 0
End If
Next
Exl_Obj.workbooks("sac1.xls").save
Exl_Obj.workbooks("sac1.xls").close
Exl_Obj.Application.Quit
set Exl_Obj=nothing

QTP Script 32 - How to compare two excel files and highlight the cells with different values in the
first file?
Excel object is being created here
Set Exl_Obj = CreateObject("Excel.Application")
Exl_Obj.Visible = True
Two files sac1 and sac2 are opened
Set WB_Obj_1= Exl_Obj.Workbooks.Open("C:\sac1.xls")
Set WB_Obj_2= Exl_Obj.Workbooks.Open("C:\sac2.xls")
Cells in the first sheet of both the files are compared
Set WS_Obj_1= WB_Obj_1.Worksheets(1)
Set WS_Obj_2= WB_Obj_2.Worksheets(1)
  For Each cell In WS_Obj_1.UsedRange
If cell.Value <> WS_Obj_2.Range(cell.Address).Value Then
cell.Interior.ColorIndex = 6
Else
cell.Interior.ColorIndex = 0
End If
Next
Exl_Obj.workbooks("sac1.xls").save
Exl_Obj.workbooks("sac1.xls").close
Exl_Obj.workbooks("sac2.xls").save
for more QTP scripts, www.ramupalanki.com

Exl_Obj.workbooks("sac2.xls").close
Exl_Obj.Application.Quit
set Exl_Obj=nothing

QTP Script 31 - How to compare range of cells in two excel files and highlight the cells with
different values in the first file?
myrange=inputbox("enter range of cells e.g. A1:A5")
Excel object is being created here
Set Exl_Obj = CreateObject("Excel.Application")
Exl_Obj.Visible = True
Two files sac1 and sac2 are opened
Set WB_Obj_1= Exl_Obj.Workbooks.Open("C:\sac1.xls")
Set WB_Obj_2= Exl_Obj.Workbooks.Open("C:\sac2.xls")
Cells in the first sheet of both the files are compared
Set WS_Obj_1= WB_Obj_1.Worksheets(1)
Set WS_Obj_2= WB_Obj_2.Worksheets(1)
For Each cell In WS_Obj_1.Range(myrange)
If cell.Value <> WS_Obj_2.Range(cell.Address).Value Then
cell.Interior.ColorIndex = 6
Else
cell.Interior.ColorIndex = 0
End If
Next
Exl_Obj.workbooks("sac1.xls").save
Exl_Obj.workbooks("sac1.xls").close
Exl_Obj.workbooks("sac2.xls").save
Exl_Obj.workbooks("sac2.xls").close
Exl_Obj.Application.Quit
set Exl_Obj=nothing

QTP Script 30 - How to rename all files in a folder and its subfolder?
At the end of the root procedure, it shows “path and names of files
which are renamed”. This msgbox is useful if the number of files is
very small. If files are in huge numbers then modify this code if you
want to see the names and path of all the files renamed or if you
don’t want this you can simply convert that msgbox into a comment.
Write this code on a notepad and save it with .vbs extension. It asks
you the path of the folder and the string to be replaced in each
filename and the new string by which the old string is to be
replaced.
Set fso = CreateObject ("Scripting.FileSystemObject")
Dim uu, uu1
total_files_renamed = 0
for more QTP scripts, www.ramupalanki.com

total_files_skipped = 0
root
set fso = nothing
Sub root
path = inputbox ("enter path")
old_string=inputbox ("enter string to be replaced")
new_string=inputbox ("enter new string")
Set folder_path = fso.GetFolder(path)
msgbox "Warning: All files within the Folder """ &_
folder_path.Path &""" will be renamed."
procedure_sub_folders folder_path , old_string, new_string
Msgbox "Total Files Renamed :" &total_files_renamed
Msgbox "Total Files Skipped :" &total_files_skipped
msgbox "Path and names of files which are renamed" &uu1
End Sub
Sub procedure_sub_folders (ByVal curr_folder, ByVal old_val, ByVal
new_val)
 Set Folders = curr_folder.SubFolders
procedure_folder curr_folder , old_val, new_val
For Each Folder in Folders
procedure_sub_folders Folder , old_val, new_val
next
end Sub
Sub procedure_folder (ByVal folder, ByVal old_val, ByVal new_val)
 Set Files = folder.Files
For Each File In Files
If inStr(1,File.Name,old_val) > 0 Then
uu= Replace(File.Path, old_val, new_val)
uu1= uu1 &vbcrlf &uu
File.Move Replace(File.Path,old_val,new_val)
total_files_renamed = total_files_renamed + 1
else
total_files_skipped = total_files_skipped + 1
End If
Next
End Sub

QTP Script 29 - How to rename all the files in a folder?

Type the below code in a notepad, save it with .vbs extension and run
it from command prompt. You have to change the folder name (C:\abc)
and the strname to suit your requirements.
Below code renames all the files in a given folder to Sac 1, Sac
for more QTP scripts, www.ramupalanki.com

2....and so on.
strComputer = "."
Set objWMIService = GetObject ("winmgmts:\\" &strComputer
&"\root\cimv2")
Set colFileList = objWMIService.ExecQuery ("ASSOCIATORS OF
{Win32_Directory.Name='C:\abc'} Where " &"ResultClass =
CIM_DataFile")
x=1
For Each objFile In colFileList
strname = "Sac " &x
strNewName = objFile.Drive &objFile.Path &strname &"."
&objFile.Extension
errResult = objFile.Rename(strNewName)
x=x+1
Next
source:http://www.microsoft.com/technet/scriptcenter/resources/qanda/
nov04/hey1109.mspx
To know more about Windows Management Instrumentation go here.
http://msdn.microsoft.com/en-us/library/aa394582(VS.85).aspx

QTP Script 28 - How to rename all subfolders within a given folder?

Type the below code in a notepad, save it with .vbs extension and run
it from command prompt.
In case nothing is entered for main_folder or search_string or
replace_string, the script will quit.
main_folder = inputbox ("Enter the main folder whose subfolders need
to be renamed" &vbcrlf &"e.g. C:\Folder")
if main_folder="" then quit_function
search_string = inputbox ("Enter the string to be searched")
If search_string = "" then quit_function
replace_string = inputbox ("Enter the string to be replaced")
If replace_string = "" then quit_function
Set object_FSO= CreateObject ("Scripting.FileSystemObject")
rename_function main_folder
Sub rename_function (byval Folder)
 GetFolder method is used to get the Folder object for the path that
you specify. You can then use the new variable containing the folder
object to access its various methods and properties.
Set object_folder = object_FSO.GetFolder (Folder)
SubFolder property returns a Folders collection consisting of all the
subfolders in a given folder.
Set sub_folders = object_folder.Subfolders
For each subfolder in sub_folders
for more QTP scripts, www.ramupalanki.com

new_foldername = (Replace (subfolder.name, search_string,

replace_string))
If new_foldername <> subfolder.Name Then
subfolder.Name = new_foldername
End If
rename_function subfolder.path
Next
End Sub
Sub quit_function
wscript.echo "Script quit_function"
wscript.quit
End sub

QTP Scripts 27 - How to add any path in the Search List '(Tools -> Options -> Folders tab)
through a script.
'How to add any path in the Search List '(Tools -> Options -> Folders
tab) through a script.
'We are opening a test called "call twra" and adding a path
C:\Program Files\Mercury Interactive\QuickTest Professional\Tests in
the Search List '(Tools -> Options -> Folders tab)
Dim qtp_app
Dim str_path
Set qtp_app = CreateObject ("QuickTest.Application")
qtp_app.Launch
qtp_app.Visible = True
qtp_app.Open "C:\Program Files\Mercury Interactive\QuickTest
Professional\Tests\call twra", True, False
'If the folder C:\Program Files\Mercury Interactive\QuickTest
Professional\Tests is not there just add it.
str_path = qtp_app.Folders.Locate ("C:\Program Files\Mercury
Interactive\QuickTest Professional\Tests")
‘If the folder is not found in the collection, add it
If qtp_app.Folders.Find (str_path) = -1 Then
qtp_app.Folders.Add str_path, 1 'Add the folder to the collection
End If
'If you have moved "<current test>" downwards in the list, bring it
back to first position.
If qtp_app.Folders.Item (2) = "<current test>" Then
 qtp_app.Folders.MoveToPos 1, 2
End If