UFT Real time Scripts 2020

For more QTP Realtime Scripts, 

MS Excel Scripts
'''Script to create a new excel file , write data
'''save the file with read and write protected
'''''pwd1 is for read protected pwd2 is for write protected
Set xl=CreateObject("Excel.Application")
Set wb=xl.Workbooks.Add
xl.DisplayAlerts=False
Set ws=wb.Worksheets("sheet1")
ws.cells(1,1)=100
ws.cells(1,2)=200
wb.Saveas "e:\data2.xls",,"pwd1","pwd2"
wb.Close
Set xl=nothing
'''Script to open excel file ,which is read and write protected write data
'''''pwd1 is for read protected pwd2 is for write protected
Set xl=CreateObject("Excel.Application")
Set wb=xl.Workbooks.Open("e:\data2.xls",0,False,5,"pwd1","pwd2")
xl.DisplayAlerts=False
Set ws=wb.Worksheets("sheet1")
ws.cells(1,2)="hello"
ws.cells(2,2)="new data"
wb.Save
wb.Close
Set xl=nothing
''Script to get the list of links in Google and do spell check
=================================================
dim d
set mw=CreateObject("Word.Application")
set d=Description.Create
d("micclass").value="Link"
set a=Browser("Google").page("Google").childobjects(d)
for i=0 to a.count-1
mw.WordBasic.filenew
s=a(i).getROProperty("innertext")
mw.WordBasic.insert s
if mw.ActiveDocument.Spellingerrors.count>0 then
Reporter.ReportEvent 1,"Spelling","spelling error :"&s
end if
mw.ActiveDocument.Close(False)
next
mw.quit
set mw=nothing
=========================================
''''Script to check ON the checkboxes in yahoo mail inbox
=========================================
Dim d
Set d=Description.Create
d("micclass").value="WebCheckBox"
Set c=Browser("Inbox (17) - Yahoo! Mail").Page("Inbox (17) - Yahoo!
Mail").ChildObjects(d)
For i=1 to 10
c(i).set "ON"
Next
========================================
'''script to select a mail having subject 'hi' or 'HI'
========================================
n=Browser("yahoo").Page("yahoo").WebTable("Inbox").RowCount
For i=2 to n
s=Browser("yahoo").Page("yahoo").WebTable("Inbox").GetCellData(i,7)
If lcase(trim(s))="hi" Then
Browser("yahoo").Page("yahoo").WebCheckBox("index:="&i-1).set "ON"
End If
Next
========================================
'''''Function to send a mail
========================================
Function SendMail(SendTo, Subject, Body, Attachment)
Set otl=CreateObject("Outlook.Application")
Set m=otl.CreateItem(0)
m.to=SendTo
m.Subject=Subject
m.Body=Body
If (Attachment <> "") Then
Mail.Attachments.Add(Attachment)
End If
m.Send
otl.Quit
Set m = Nothing
Set otl = Nothing
End Function

Call SendMail("a@thdf.com","hi","This is test mail for testing","")
'''''''''''''''create a new text file
=================================================
Dim fs,f
Set fs=CreateObject("Scripting.FileSystemObject")
Set f=fs.CreateTextFile("e:\file1.txt")
f.WriteLine "hello"
f.WriteLine "this is sample data"
f.Close
Set fs=nothing
=================================================
'''''''''''''''read data from a text file
=================================================
Dim fs,f
Set fs=CreateObject("Scripting.FileSystemObject")
Set f=fs.OpenTextFile("e:\file1.txt",1)
While f.AtEndOfLine<>True
msgbox f.ReadLine
Wend
f.Close
Set fs=nothing
=================================================
''''''''''create a new excel file and write data
=================================================
Dim xl,wb,ws
Set xl=CreateObject("Excel.Application")
Set wb=xl.Workbooks.Add
Set ws=wb.Worksheets("sheet1")
ws.cells(1,1)=10
ws.cells(2,1)=20
ws.cells(3,1)=50
wb.SaveAs "e:\file1.xls"
wb.Close
Set xl=nothing
=================================================
'''''''open existing file and write data in second column in Sheet1
=================================================
Dim xl,wb,ws
Set xl=CreateObject("Excel.Application")
Set wb=xl.Workbooks.Open("e:\file1.xls")
Set ws=wb.Worksheets("sheet1")
ws.cells(1,2)="mindq"
ws.cells(2,2)="hyd"
ws.cells(3,2)="ap"
wb.Save
wb.Close
Set xl=nothing
=================================================
'''''''''''read data from excel from rows and columns
=================================================
Dim xl,wb,ws
Set xl=CreateObject("Excel.Application")
Set wb=xl.Workbooks.Open("e:\file1.xls")
Set ws=wb.Worksheets("sheet1")
r=ws.usedrange.rows.count
c=ws.usedrange.columns.count
For i=1 to r
v=""
For j=1 to c
v=v&" "& ws.cells(i,j)
Next
print v
print "-----------------------"
Next
wb.Close
Set xl=nothing
=================================================
''''''''''''''''get the bgcolor in a cell in excel
=================================================
Dim xl,wb,ws
Set xl=CreateObject("Excel.Application")
Set wb=xl.Workbooks.Open("e:\file3.xls")
Set ws=wb.Worksheets("sheet1")
r=ws.usedrange.rows.count
c=ws.usedrange.columns.count
For i=1 to r
For j=1 to c
x=ws.cells(i,j).interior.colorindex
msgbox x
Next
Next
wb.Close
Set xl=nothing
=================================================
'''''''''''''''''''''create word and write data
=================================================
dim mw
set mw=CreateObject("Word.Application")
mw.Documents.Add
mw.selection.typetext "hello"
mw.ActiveDocument.SaveAs "e:\file1.doc"
mw.quit
set mw=nothing
=================================================
''''''''''script will display all the doc files in all the drives in the system
=================================================
Dim mw
Set mw=CreateObject("Word.Application")
Set fs=createobject("Scripting.FileSystemObject")
Set d=fs.Drives
mw.FileSearch.FileName="*.doc"
For each dr in d
msgbox dr
mw.FileSearch.LookIn=dr
mw.FileSearch.SearchSubFolders=True
mw.FileSearch.Execute
For each i in mw.FileSearch.FoundFiles
print i
Set f=fs.GetFile(i)
print f.Name&" "&f.Size&" "&f.DateCreated
print "-------------------------------------------------------------------"
Next
Next
mw.Quit
=================================================
'''''''''Open Internet Explorer and navigate to yahoomail
=================================================
Dim ie
Set ie=CreateObject("InternetExplorer.Application")
ie.Visible=True
ie.Navigate "www.yahoomail.com"
x=Browser("CreationTime:=0").GetROProperty("title")
msgbox x
=================================================
''''''Create word, Create table and write all the services names
=================================================
Set mw = CreateObject("Word.Application")
mw.Visible = True
Set dc = mw.Documents.Add()
Set objRange = dc.Range()
dc.Tables.Add
objRange,1,3
Set objTable = dc.Tables(1)
x=1
strComputer = "."
Set wms=GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = wms.ExecQuery("Select * from Win32_Service")
For Each s in colItems
If x > 1 Then
objTable.Rows.Add()
End If
objTable.Cell(x, 1).Range.Font.Bold = True
objTable.Cell(x, 1).Range.Text = s.Name
objTable.Cell(x, 2).Range.text = s.DisplayName
objTable.Cell(x, 3).Range.text = s.State
x = x + 1
Next