APPS folder Given by sir

APPS folder Given by sir

QTP code to find the files name and subfolders of a folder

'to find the files name and subfolders of a folder
      Option explicit
      Dim ohdd, ofo, osfs, n, s, osf, ofs, of, na, ns
'goto hdd
      Set ohdd=createobject("scripting.filesystemobject")
'goto folder
      Set ofo=ohdd.getfolder("F:\QTP")
'goto subfolder
      Set osfs=ofo.subfolders
      Set ofs=ofo.Files
For each of in ofs
na=of.name
ns=of.size
ns=ns/1024
print(na&"   size   =  "&ns&"KB")
Next
print ("------folders-----")
'get all folders names and size individually
For each osf in osfs
   n=osf.name
   s=osf.size
   s=s/1024^2
   print(n&" Size is ="&s&"MB")
Next
'destroy objects
Set osf=nothing
Set osfs=nothing
Set ohdd=nothing

VBSCRIPT to check memory of subfolders

'VBSCRIPT to check memory of subfolders
Option explicit
Dim ohdd, ofo, osfs, n, s, osf
'goto hdd
Set ohdd=createobject("scripting.filesystemobject")
'goto folder
Set ofo=ohdd.getfolder("F:\QTP")
'goto subfolder
Set osfs=ofo.subfolders
'get all folders names and size individually
For each osf in osfs
   n=osf.name
   s=osf.size
   s=s/1024^2
   print(n&" Size is ="&s&"MB")
Next
'destroy objects
Set osf=nothing
Set osfs=nothing
Set ohdd=nothing

VBSCRIPT code to read particular in text file

'VBSCRIPT code to read particular in text file
Option explicit
Dim ohdd, otf, i
'connect to hard disk and open text file
Set ohdd=createobject("scripting.filesystemobject")
Set otf=ohdd.OpenTextFile("C:\Documents and Settings\Administrator\Desktop\11.txt")
'skip line until the required line
For i=1 to 4 step 1
otf.SkipLine
Next
'read particular line
i=otf.ReadLine
print(i)
otf.Close
'destroy objects
Set otf=nothing
Set ohdd=nothing

Delete a sheet to the existing workbook

'Delete a sheet to the existing workbook

Option explicit

Dim oex, owb, owd

'goto excel sw

            Set oex=createobject("Excel.Application")

            oex.Visible=true

'goto workbook

            Set owb=oex.Workbooks.Open("F:\Book1.xls")

'goto worksheet

            Set owd=owb.Worksheets("Sheet5")

            owd.delete

'save excel

            owb.Save

'close Excel

            oex.Quit         

'Destroy objects

            Set owd=nothing

            Set owb=nothing

            Set oex=nothing

QTPSCRIPT to Add new worksheet

'Add new worksheet

             Option explicit

             Dim oex, owb, ows

'goto excel sw

            Set oex=createobject("Excel.Application")

            oex.Visible=true

'goto workbook

            Set owb=oex.Workbooks.Open("F:\Book1.xls")

'goto worksheet

            Set ows=owb.Worksheets.add

'Rename Sheet

'save excel

            owb.Save

'close Excel

            oex.Quit         

'Destroy objects

            Set ows=nothing

            Set owb=nothing

            Set oex=nothing

QTP SCRIPT for Creating charts in excel

'Creating charts using excel

Option explicit

Dim oex, owb, ows, orng, och, i

'goto excel sw

            Set oex=createobject("Excel.Application")

            oex.Visible=true

'go to excel wb

            Set owb=oex.Workbooks.Open("F:\Book1.xls")

'goto excel sw

            Set ows=owb.Worksheets("Sheet3")

'set range

            Set orng=ows.range("B2","C21")

'create charts

            For i=61 to 70 step 1

                        Set och=owb.Charts.add

                        och.name="ind vs pak"

                        och.charttype=i

                        och.setsourcedata orng, 2

                        och.location 2, "Sheet3"

   Next

'close excel

            owb.Save

            oex.Quit

'destroy objects

            Set ows=nothing

            Set owb=nothing

            Set oex=nothing

'Rename excel worksheet

Option explicit

Dim oex, owb, ows

'goto excel sw

            Set oex=createobject("Excel.Application")

            oex.Visible=true

'goto workbook

            Set owb=oex.Workbooks.Open("F:\Book1.xls")

'goto worksheet

            Set ows=owb.Worksheets("1")

'Rename Sheet

            ows.name="Mindq"

'save excel

            owb.Save

'close Excel

            oex.Quit         

'Destroy objects

            Set ows=nothing

            Set owb=nothing

            Set oex=nothing

QTPSCRIPT for Formatting and changing colors by automation

'Color index automation

            Option explicit

            Dim oex, owb, ows, i

'launch excel application

            Set oex=createobject("Excel.Application")

            oex.Visible=true          'set excel as visible

'goto excel workbook

            Set owb=oex.Workbooks.Add

'goto worksheet

            Set ows=owb.Worksheets("sheet1")

                        For i=1 to 56 step 1

                                    ows.cells(i,1)="Abdhul Kalam"          'fill first row first column with some data

                                    ows.cells(i,1).font.bold=true   'set as bold

                                    ows.cells(i,1).font.size=12                  'to set data size

                                    ows.cells(i,1).font.colorindex=i          'change color from 1 to 56

                        Next

'autofit cells

ows.rows.autofit

ows.columns.autofit

'save and close excel software

owb.SaveAs("F:\1.xls")                                   'use save for existing file and save as for existing file

oex.Quit

'destroy objects

Set ows=nothing

Set owb=nothing

Set oex=nothing

Command Prompt Automation

Command prompt automation

Option explicit

 Dim owsh

Set owsh=createobject("wscript.shell")

owsh.run("cmd /k cd\ &cd C:\Program Files\Java\jdk1.5.0_22\bin &javac Calculator.java & java Calculator")

Set owsh=nothing

QTP Script for automation of Google Site by using Keyboard automation process

'Automation of Google Site by using Keyboard automation process

    Option explicit
    Dim owsh, i

'launch google site
systemutil.Run("http:\\www.google.com")

'keyboard automation to select item in cache
Set owsh=createobject("wscript.shell")
'enter keyword in edit box 
owsh.SendKeys("Mindq")

'press down arrow until loop completed by key board automation
For i=1 to 5 step 1
owsh.sendkeys("{DOWN}")
Next
'press Enter key after completion of loop
owsh.sendkeys("{ENTER}")
'close  browser by by pressing (ALT+F4)
owsh.sendkeys("%{F4}")

Send multiple mails using MS Excel

Option explicit
Dim oex, owb, ows, u, p, i, noms, x
'go to excel software
        Set oex=createobject("Excel.Application")
        oex.Visible=true
'go to excel file
        Set owb=oex.Workbooks.Open("F:\Book1.xls")
'goto work sheet
        Set ows=owb.Worksheets("Sheet1")
'count no mails to be send
        noms=ows.usedrange.rows.count
'Associate functions file
        executefile("F:\QTP\yahoo.vbs")
'launch browser
        launch
'login
        u="XXXXXXXX"
        p="XXXXXXXX"
        login u,p
'continue loop to all the mail ids in the excel list
        For i=2 to noms  step 1
                popup 'function to handle unexpected popups
                'click compose
                         With browser("title:=.*")
                With .page("title:=.*")
        .webbutton("name:=Compose","index:=0").click
                 End With
                        End With
                       'fill fields to send mail
          popup 'function to handle unexpected popups
        With browser("title:=.*")
                        With .page("title:=.*")
                         .webedit("name:=to").set ows.cells(i,1)   'fill to address
                         .webedit("name:=cc").Set ows.cells(i,2) 'fill cc address field
                         .webedit("name:=bcc").Set ows.cells(i,3)     'fill bcc address field
                         .webedit("name:=Content").Set ows.cells(i,4)  'fill body of mail
                                .webbutton("name:=Send").Click
                         End With
                    End With
'check correctness of mail sending
With browser("title:=.*")
With .page("title:=.*")
x=.webelement("class:=emails").GetROProperty ("innertext")
If trim(x)="Your email was successfully sent." Then
ows.cells(i,6)="Test Passed"
else
ows.cells(i,6)="Test Failed"
End If
.link("name:=Back to Inbox").Click
End With
End With
Next
   logout 'function to signout
'save Excel file
owb.Save
oex.Quit
'Destroy objects
Set ows=nothing
Set owb=nothing
Set oex=nothing

Sample Resume given by our sir

Sample Resume Given by Our Sir Click HereGiven by Our Sir  

To find Gross Salary

Option explicit
Dim bsal, gsal, comm

'Aquiring Basic salary
        bsal=inputbox("Enter basic salary")

'finding commision
        If bsal>=30000 Then
         comm=bsal*10/100
        elseif Bsal<30000 and bsal>=15000 then
         comm=bsal*5/100
        else
         comm=200
        End If

'calculating gross sal
gsal=bsal+comm
msgbox(gsal)

To find week day by giving date as input

option explicit
dim x, y

x=inputbox("Enter date")
x=cdate(x)
y=weekday(x)
Select Case y

Case 1
msgbox("sunday")
Case 2
msgbox("Monday")
Case 3
msgbox("Tuesday")
Case 4
msgbox("Wednsday")
Case 5
msgbox("Thursday")
Case 6
msgbox("Friday")
Case 7
msgbox("Saterday")
End Select

VBSCRIPT code to find day by using select case

Option explicit
Dim dn
dn=inputbox("enter day number")
Select Case dn
    Case 1
msgbox("sunday")
Case 2
msgbox("monday")
Case 3
msgbox("tuesday")
Case 4
msgbox("wednsday")
Case 5
msgebox("thursday")
Case 6
msgbox("friday")
Case 7
msgbox("saterday")
Case else
msgbox("enter correctday")
 End Select

To check weather a particular site exist or not

'launching google site
systemutil.Run("ADDRESS OF WEBSITE")
If browser("title:=Google.*").Exist Then
       msgbox ("window opend")
else
        msgbox("window not opened")
End If
browser("title:=.*").Close

Type of card validation by using select case method

'card validation by using select case method

Option explicit

Dim ctype 'declare card type

'enter card type as input

ctype=inputbox("Enter type of card") 

        Select Case ctype

          Case "visa"

            msgbox("Card valid")

         Case "master"

          msgbox("card valid")

         Case "AE"

         msgbox("invalid card")

         End Select

QTP &VB Script code to Send SMS using Way2sms to excel stored numbers and msgs

option explicit
Dim oex, owb, ows, mno, msg, x, ns, i

'goto excel sw
        Set oex=createobject("Excel.Application")
        oex.Visible=true
'goto workbook
        Set owb=oex.Workbooks.Open("F:\Book1")
'goto worksheet
Set ows=owb.Worksheets("Sheet2")
ns=ows.usedrange.rows.count

'launch way2sms
         systemutil.Run("www.way2sms.com")

'login
With browser ("title:=Free SMS.*")
With .page("title:=Free SMS.*")
.webedit("name:=username").set "Mobile Number"
.webedit("name:=password").set "Password"
.webbutton("name:=Login").click
End With
End With

'continue loop until last row
For i=2 to ns step 1
mno=ows.cells(i,1) 'retrive mobile number
msg=ows.cells(i,2) 'retrive msg to send

'click send  FREE sms link
With browser("title:=Free SMS.*")
With .page("title:=Free SMS.*")
.webelement("html tag:=DIV","index:=12").Click
End With
End With

'click send sms
With browser("title:=Free SMS.*")
With .page("title:=Free SMS.*")
.link("html tag:=A","index:=52").Click
End With
End With

'fill fields to send sms
With browser("title:=Free SMS.*")
With .page("title:=Free SMS.*")
.webedit("value:=Mobile Number").Set mno
.webedit("name:=textArea").Set msg
.webbutton("name:=Send SMS").Click
End With
End With

'validating sms status
With browser ("title:=Free SMS.*")
With .page("title:=Free SMS.*")
With .frame ("name:=frame")
x=.webelement("html tag:=DIV","index:=9").GetROProperty("innertext")

If trim(x)="Message has been submitted successfully" Then
ows.cells(i,3)="Test passed"
Else
ows.cells(i,3)="Test Failed"
End If

End With
End With
End with
Next

'signout
With browser("title:=.*")
With .page("title:=.*")
            .webelement("html id:=logoutBTN").Click
                    End With
End With

'close browser
browser("title:=.*").Close

'handle popup adds
If browser("title:=.*").Exist Then
browser("title:=.*").Close
End If

'auto fit rows & clmns
ows.rows.autofit
ows.columns.autofit

'save & close
owb.Save
  oex.Quit

'destroy object
  Set ows=nothing
  Set owb=nothing
  Set oex=nothing

VbScript code to add multiple values in Excel files

Option explicit
Dim oex, owb, nr, ows, a, b, eop, qop, i

'open excel sw
         Set oex=createobject("Excel.Application")
         oex.Visible=true 'set excel as visible
'open excel wb
       set owb=oex.Workbooks.Open("F:\Book1.xls")
'open excel worksheet
         Set ows=owb.Worksheets("Sheet2")

'count no of rows
         nr=ows.usedrange.rows.count 'count no of rows to be added

For i=2 to nr step 1
        a=ows.cells(i,1) 'get first input
         a=cint(a)
         b=ows.cells(i,2) 'get second input
         b=cint(b)
                eop=ows.cells(i,3) 'get value from excel
        qop=a+b 'add two inputs by using qtp
        print(qop)
        ows.cells(i,4)=qop 'store the ouput in qtp

      'check correct ness of addition
                 If eop=qop Then
         ows.cells(i,5)="Correct Value"
          Else
        ows.cells(i,5)="Incorrect Value"
         End If
Next

'save and close excel file
         owb.Save
        oex.Quit

'destroy object by de allocating the memory
         Set ows=nothing
         Set owb=nothing
         Set oex=nothing

VBSCRIPT to find Used rows & columns of Excel

Option explicit
Dim oex,owb,ows,nr,nc
'open excel s/w
           Set oex=createobject("Excel.Application") 'create object ot excel application
          oex.Visible=true 'excel file will be visible while running
'go to excel file
         Set owb=oex.Workbooks.Open("PATH OF EXCEL FILE.xls") 'Create object to workbook
'open excel sheet.
         Set ows=owb.Worksheets("Sheet1") 'Create object to worksheet
          nr=ows.usedrange.rows.count 'count no of used rows
          nc=ows.usedrange.columns.count 'count no of used columns
         print("nc "&nc) 'display no of columns
         print("nr "&nr) 'displya no of rows
              oex.Quit 'close excel application
'destry objects
Set ows=nothing 'de allocate the memory of worksheet object
Set owb=nothing 'de allocate the memory of workbook object
Set oex=nothing 'de allocate the memory of excel application object

QTP script to Count no of rows and columns of EXCEL file

Option explicit
Dim oex,owb,ows,nr,nc

'open excel s/w
         Set oex=createobject("Excel.Application") 'create object ot excel application
        oex.Visible=true 'excel file will be visible while running

'go to excel file
 Set owb=oex.Workbooks.Open("PATH OF EXCEL FILE.xls") 'Create object to workbook

'open excel sheet.
       Set ows=owb.Worksheets("Sheet1") 'Create object to worksheet
             nr=ows.rows.count 'count no of rows
 nc=ows.columns.count 'count no of columns
 print("nc "&nc) 'display no of columns
           print("nr "&nr) 'displya no of rows
oex.Quit 'close excel application

'destroy objects
 Set ows=nothing                            'de allocate the memory of worksheet object
Set owb=nothing 'de allocate the memory of workbook object
 Set oex=nothing 'de allocate the memory of excel application object 

VBSCRIPT to find age difference

Option explicit
Dim x, y, z, b, mo
x=inputbox("enter date")
x=cdate(x)
y=date()
z=datediff("m",x,y)
b=z/12
mo=z mod 12
print("years=" &b)
print("months=" &mo)

VBSCRIPT to addition and multiply to numbers

'vbscript to addition and multiply to numbers
option explicit
dim x, y, add, mul, mod       'declaring sites
x=inputbox(x)
y=inputbox(y)
mul=x*z
add=x*z
msgbox("multiplication"&add)
msgbox("addition"&add)

QTP code to Delete mails recieved in present month

Option explicit
Dim u, p, i, nomp, x, k

'associate functions file
Executefile("F:\QTP\gml.vbs")

'launching site
launch

'log in site
u="EMAIL ID"
p="EMAIL ID"
login u,p

'click inbox
inbx
Do
'count no of rows
With browser("title:=.*")
With .page("title:=.*")
nomp=.webtable("name:=t").getroproperty("rows")
End With
End With
'get date of recieving mail
For i=1 to nomp step 1
With browser("title:=.*")
With .page("title:=.*")
x=.webtable("name:=t").GetCellData(i,4)
End With
End With
'check weather todays mail or not and delete
If instr(x, "am") or instr(x,"pm") Then
With browser("title:=.*")
With .page("title:=.*")
.webcheckbox("name:=t","index:="&i-1).set "on"
.webbutton("name:=Delete","index:=0").Click
i=i-1
End with
End with
'check weather may months or not and delete
elseif instr(x, "May") Then
With browser("title:=.*")
With .page("title:=.*")
.webcheckbox("name:=t","index:="&i-1).set "on"
.webbutton("name:=Delete","index:=0").Click
i=i-1
End with
End with
End If
Next
'check any older mails exist or not
With browser("title:=.*")
With .page("title:=.*")
k=.webelement("html tag:=B","index:="&p).getroproperty ("innertext")
End With
End With
'click older mails icon after deleting present page mails
If k="Older ›" Then
With browser("title:=.*")
With .page("title:=.*")
k=.webelement("html tag:=B","index:="&p).click
End With
End With
'increase oldermails icon upto 11 step by step
If p<>11 Then
p=p+1
End If
Else
Exit do
End If
Loop while 2>1
print("test passed")
sgnf

QTP code for counting Unread mails in Gmail

Option explicit
Dim u,p,k,i,nomp,x,y,j,eur,it,aur
'associate functions file
Executefile("F:\QTP\gml.vbs")
'launching site
launch
'log in site
u="EMAIL ID"
p="ENCRYPTED PASSWORD"
login u,p
'click inbox
inbx
k=9
Do
With browser("title:=.*")
With .page("title:=.*")
nomp=.webtable("name:=t").GetRoproperty("rows")
End With
End With
nomp=(nomp+27)*4
'count no of unread mails in single page
For i=28 to nomp-83 step 4
With browser("title:=.*")
With .page("title:=.*")
x=.webelement("html tag:=TD","index:="&i).object.currentstyle.backgroundColor
If x="#ffffff" Then
eur=eur+1
End If
End With
End With
Next
'check whether older mails exist or not
With browser("title:=.*")
With .page("title:=.*")
y=.webelement("html tag:=B","index:="&k).getroproperty("innertext")
End With
End With
'click older mails link
If y="Older ›" Then
With browser("title:=.*")
With .page("title:=.*")
.webelement("html tag:=B","index:="&k).click
End With
End With
Else
Exit do
End If
If k<>11 Then
k=K+1
end if
Loop while 2>1 'infinite loop
'getting site showing count
With browser("title:=.*")
With .page("title:=.*")
x=.link("name:=Inbox.*").GetROProperty("innertext")
End With
End With
aur=mid(x,8,len(x)-8)
aur=cint(aur)
If aur=eur Then
msgbox("Test Passed")
else
msgbox("Test Failed")
End If
'sign out and arrange for next user login
sgnf

QTP code to count inbox mails

Option explicit
Dim u,p,m,em,k,x,sm
'associate functions file
Executefile("F:\QTP\gml.vbs")
'launching site
launch
'log in site
u="MAIL ID"
p="ENCRYPTED PASSWORD"
login u,p
'click inxox
inbx
em=0
k=9
Do
'counting no of mails in first page and clicking next page
With browser("title:=.*")
With .page("title:=.*")
m=.webtable("name:=t").getroproperty("rows")
em=em+m
x=.webelement("html tag:=B","index:="&k).getroproperty("innertext")
If x="Older ›"  Then
.webelement("html tag:=B","index:="&k).click
'increase k value until k becomes 11 since index is varying as newer and newest is adding for the next time
if  k<>11then
k=k+1
                                End If
else
exit do
End If
End With
End With
Loop while 2>1
'taking data of total mails showing
With browser("title:=.*")
With .page("title:=.*")
sm=.webelement("html tag:=B","index:=10").GetROProperty ("innertext")
sm=cint(sm)
If em=sm Then
print("test passed")
else
print("test failed")
End If
End With
End With
sgnf

QTP code to Send Sms using Way 2 SMS

option explicit
Dim x, n
'launch way2sms
systemutil.Run("www.way2sms.com")
'login
With browser ("title:=Free SMS.*")
With .page("title:=Free SMS.*")
.webedit("name:=username").set "Mobile Number"
.webedit("name:=password").set "Password"
.webbutton("name:=Login").click
End With
End With
'click send  FREE sms
With browser("title:=Free SMS.*")
With .page("title:=Free SMS.*")
.webelement("html tag:=DIV","index:=12").Click
End With
End With

'click send sms
With browser("title:=Free SMS.*")
With .page("title:=Free SMS.*")
.link("html tag:=A","index:=52").Click
End With
End With
'fill fields to send sms
With browser("title:=Free SMS.*")
With .page("title:=Free SMS.*")
.webedit("value:=Mobile Number").Set "Mobile Number "
.webedit("name:=textArea").Set "Message"
.webbutton("name:=Send SMS").Click
         End With
End With
'validating sms status
With browser ("title:=Free SMS.*")
With .page("title:=Free SMS.*")
With .frame ("name:=frame")
x=.webelement("html tag:=DIV","index:=9").GetROProperty("innertext")
If trim(x)="Message has been submitted successfully" Then
msgbox("Send SMS test passed")
Else
msgbox("send sms test failed")
End If
End With
End With
end with

Functions file for Gmail site

'launch google site
function launch()
systemutil.Run("http://www.gmail.com")
end function

function login(byval x,byval y)
With Browser("title:=.*")
With .browser("title:=.*")
.webedit("name:=Email").set x
.webedit("name:=Passwd").setsecure y
.webbutton("name:=Sign in").Click
End With
End With
end function


function inbx()
With browser("title:=.*")
With .page("title:=.*")
.link("html tag:=A","index:=1").Click
End With
End With
end function

function sgnf()
With browser("title:=.*")
With .page("title:=.*")
.link("html tag:=A","name:=Sign out").Click
End With
End With
'arrange window for the new user
With browser("title:=.*")
With .page("title:=.*")
.link("name:=Sign in with a different account ").Click
End With
End With
With browser("title:=.*")
With .page("title:=.*")
.webelement("html tag:=A","x:=672","y:=274").click
End With
End With
With browser("title:=.*")
With .page("title:=.*")
.webelement("html tag:=BUTTON").Click
End With
End With
With browser("title:=.*")
With .page("title:=.*")
.link("name:=Done").Click
End With
End With
browser("title:=.*").Close

end function

Qtp code for Sending email using GMail site

Option explicit
Dim u, p, oex, ows, owb, i, nur, nuc, s

'go to excel file
Set oex=createobject("Excel.Application")
oex.Visible=true
'go to workbook
Set owb=oex.Workbooks.Open("F:\QTP\mytest1.xls")
'go to worksheet
Set ows=owb.Worksheets("Sheet1")
    nur=ows.usedrange.rows.count
nuc=ows.usedrange.columns.count
'associate functions file
Executefile("F:\QTP\gml.vbs")
'launching site
launch
'log in site
u="USER ID"
p="PASSWORD"
login u, p
For i=2 to nur step 1
'click compose
With browser("title:=.*")
With .page("title:=.*")
.link("name:=Compose Mail").click
End With
End With
'Fill fields to send mail
With browser("title:=.*")
With .page("title:=.*")
.webedit("name:=to").Set ows.cells(i,1)
.webedit("name:=cc").Set ows.cells(i,2)
.webedit("name:=bcc").Set ows.cells(i,3)
.webedit("name:=subject").Set ows.cells(i,4)
.webedit("name:=body").Set ows.cells(i,5)
.webbutton("name:=Send","index:=0").Click
End With
End With
'check correctness of mail
With browser("title:=.*")
With .page("title:=.*")
s=.webelement("html tag:=B","x:=655","y:=116").GetROProperty ("innertext")
        End With
End With
If trim(s)="Your message has been sent." Then
ows.cells(i,6)="Test Passed"
ows.cells(i,6).font.colorindex=1
Else
ows.cells(i,6)="Test Failed"
End If
Next
'signout and close browser
sgnf
'save work sheet
ows.rows.autofit
ows.columns.autofit
owb.Save
'close excel
oex.Quit
'destroy objects
Set ows=nothing
Set owb=nothing
Set oex=nothing