VB Script Examples

‘**************************************************************************
'1    Print Hello World
‘**************************************************************************

Print "Hello World"

‘**************************************************************************
'2    Find whether given number is a odd number
‘**************************************************************************
Dim oNumber
oNumber=4
If oNumber mod 2 <>0 Then
    Print "The Number "& oNumber &" is an Odd Number"
else
    Print "The Number "& oNumber &" is not an Odd Number"
End If

‘**************************************************************************
'3    Print odd numbers between given range of numbers
‘**************************************************************************

Dim RangeStart
Dim RangeEnd
Dim iCounter
RangeStart=10
RangeEnd=20

For iCounter=RangeStart to RangeEnd

    If iCounter mod 2 <>0 Then
        Print  oNumber
    End If

Next

‘**************************************************************************
'4    Find the factorial of a given number
‘**************************************************************************

Dim oNumber
Dim iCounter
Dim fValue

oNumber=6
fValue=1

For iCounter=oNumber to 1 step-1
    fValue=fValue*iCounter
Next
print  fValue

‘**************************************************************************
'5    Find the factors of a given number
‘**************************************************************************
Dim oNumber
Dim iCounter

oNumber=10

For iCounter=1 to oNumber/2
    If oNumber mod iCounter=0 Then
        print iCounter
    End If
Next
print oNumber

‘**************************************************************************
'6    Print prime numbers between given range of numbers
‘**************************************************************************

Dim RangeStart
Dim RangeEnd
Dim iCounter
RangeStart=1
RangeEnd=30

For iCounter=RangeStart to RangeEnd

    For iCount=2 to round(iCounter/2)
            If iCounter mod iCount=0 Then
                Exit for
            End If
    Next
   
    If iCount=round(iCounter/2)+1 or iCounter=1 Then
            print iCounter
    End If
Next


‘**************************************************************************
'7    Swap 2 numbers with out a temporary variable
‘**************************************************************************

Dim oNum1
Dim oNum2

oNum1=1055
oNum2=155

oNum1=oNum1-oNum2
oNum2=oNum1+oNum2
oNum1=oNum2-oNum1
print oNum1
print oNum2

‘**************************************************************************
'8    Write a program to Perform specified Arithmetic Operation on two given numbers
‘**************************************************************************
Dim oNum1
Dim oNum2
Dim oValue

oNum1=10
oNum2=20

OperationtoPerform="div"

Select Case lcase(OperationtoPerform)

                Case "add"
                                oValue=oNum1+oNum2
                Case "sub"
                                oValue=oNum1-oNum2
                Case "mul"
                                oValue=oNum1*oNum2
                Case "div"
                                oValue=oNum1/ oNum2
End Select
print oValue

‘**************************************************************************
'9    Find the length of a given string
‘**************************************************************************
Dim oStr
Dim oLength
oStr="Sudhindra"
oLength=len(oStr)
print oLength

‘**************************************************************************
10    Reverse given string
‘**************************************************************************
Dim oStr
Dim oLength
Dim oChar
Dim iCounter

oStr="Sudhindra"
oLength=len(oStr)

For iCounter=oLength to 1 step-1
        oChar=oChar&mid(oStr,iCounter,1)
Next
print oChar

‘**************************************************************************
11    Find how many alpha characters present in a string.
‘**************************************************************************
Dim oStr
Dim oLength
Dim oChar
Dim iCounter

oStr="su1h2kar"
oLength=len(oStr)

oAlphacounter=0

For iCounter=1 to oLength

    If not isnumeric (mid(oStr,iCounter,1)) then
        oAlphacounter=oAlphacounter+1
    End if
   
Next
print oAlphacounter

‘**************************************************************************
12    Find occurrences of a specific character in a string
‘**************************************************************************
Dim oStr
Dim oArray
Dim ochr
oStr="Sudhindra"
ochr="a"

oArray=split(oStr,ochr)
print ubound(oArray)
‘**************************************************************************
13    Replace space with tab in between the words of a string.
‘**************************************************************************
Dim oStr
Dim fStr

oStr="Quick Test Professional"

fStr=replace(oStr," ",vbtab)
print fStr

‘**************************************************************************
'14    Write a program to return ASCII value of a given character
‘**************************************************************************
Dim ochr
Dim aVal

ochr="A"

aVal=asc(ochr)
print aVal

‘**************************************************************************
'15    Write a program to return character corresponding to the given ASCII value
‘**************************************************************************
Dim ochr
Dim aVal

aVal=65

oChr=chr(aVal)
print oChr

‘**************************************************************************
'16    Convert string to Upper Case
‘**************************************************************************
Dim oStr
Dim uStr

oStr="QuickTest Professional"

uStr=ucase(oStr)
print uStr

‘**************************************************************************
'17    Convert string to lower case
‘**************************************************************************
Dim oStr
Dim lStr

oStr="QuickTest Professional"
lStr=lcase(oStr)
print lStr


‘**************************************************************************
'18    Write a program to Replace a word in a string with another word
‘**************************************************************************

Dim oStr
Dim oWord1
Dim oWord2
Dim fStr

oStr="Mercury Quick Test Professional"
oWord1="Mercury"
oWord2="HP"

fStr=replace(oStr,oWord1,oWord2)
print fStr
‘**************************************************************************
'19    Check whether the string is a POLYNDROM
‘**************************************************************************

Dim oStr

oStr="bob"
fStr=StrReverse(oStr)
If oStr=fStr Then
    Print "The Given String "&oStr&" is a Palindrome"
    else
    Print "The Given String "&oStr&" is not a Palindrome"
End If

‘**************************************************************************
'20    Verify whether given two strings are equal
‘**************************************************************************
Dim oStr1
Dim ostr2

oStr1="qtp"
oStr2="qtp"
If  oStr1=oStr2 Then
        Print "The Given Strings are Equal"
        else
        Print "The Given Strings are not Equal"
End If

‘**************************************************************************
'21    Print all values from an Array
‘**************************************************************************
Dim oArray
Dim oCounter
oArray=array(1,2,3,4,"qtp","Testing")

For oCounter=lbound(oArray) to ubound(oArray)
    print oArray(oCounter)
Next


‘**************************************************************************
'22    Sort Array elements
‘**************************************************************************
Dim oArray
Dim oCounter1
Dim oCounter2
Dim tmp

oArray=array(8,3,4,2,7,1,6,9,5,0)

For oCounter1=lbound(oArray) to ubound(oArray)

        For oCounter2=lbound(oArray) to ubound(oArray)-1

                    If oArray(oCounter2)>oArray(oCounter2+1) Then
                        tmp=oArray(oCounter2)
                        oArray(oCounter2)=oArray(oCounter2+1)
                        oArray(oCounter2+1)=tmp
                    End If
                     
        Next
   
Next

For oCounter1=lbound(oArray) to ubound(oArray)
    print oArray(oCounter1)
Next
   

‘**************************************************************************
'23    Add two 2X2 matrices
‘**************************************************************************
Dim oArray1(1,1)
Dim oArray2(1,1)
Dim tArray(1,1)

oArray1(0,0)=8
oArray1(0,1)=9
oArray1(1,0)=5
oArray1(1,1)=-1

oArray2(0,0)=-2
oArray2(0,1)=3
oArray2(1,0)=4
oArray2(1,1)=0

tArray(0,0)=oArray1(0,0)+ oArray2(0,0)
tArray(0,1)=oArray1(0,1)+oArray2(0,1)
tArray(1,0)=oArray1(1,0)+oArray2(1,0)
tArray(1,1)=oArray1(1,1)+oArray2(1,1)

‘**************************************************************************
'24    Multiply Two Matrices of size 2X2
‘**************************************************************************

Dim oArray1(1,1)
Dim oArray2(1,1)
Dim tArray(1,1)

oArray1(0,0)=8
oArray1(0,1)=9
oArray1(1,0)=5
oArray1(1,1)=-1

oArray2(0,0)=-2
oArray2(0,1)=3
oArray2(1,0)=4
oArray2(1,1)=0

tArray(0,0)=oArray1(0,0)* oArray2(0,0)+ oArray1(0,1)* oArray2(1,0)
tArray(0,1)=oArray1(0,0)* oArray2(0,1)+ oArray1(0,1)* oArray2(1,1)
tArray(1,0)=oArray1(1,0)* oArray2(0,0)+ oArray1(1,1)* oArray2(1,0)
tArray(1,1)=oArray1(1,0)* oArray2(0,1)+ oArray1(1,1)* oArray2(1,1)

‘**************************************************************************
'25    Convert a String in to an array
‘**************************************************************************

Dim oStr
Dim iCounter
oStr="Quick Test Professional"
StrArray=split(oStr)

For iCounter=0 to ubound(StrArray)
        print StrArray(iCounter)
Next


‘**************************************************************************
'26    Convert a String in to an array using ‘i‘ as delimiter
‘**************************************************************************

Dim oStr
Dim iCounter
oStr="Quick Test Professional"
StrArray=split(oStr,"i")

For iCounter=0 to ubound(StrArray)
        print StrArray(iCounter)
Next

‘**************************************************************************
'27    Find number of words in string
‘**************************************************************************

Dim oStr
Dim iCounter
oStr="Quick Test Professional"
StrArray=split(oStr," ")
print "Theere are "&ubound(StrArray)+1&" words in the string"

‘**************************************************************************
'28    Write a program to reverse the words of a given string.
‘**************************************************************************

Dim oStr
Dim iCounter
oStr="Quick Test Professional"
StrArray=split(oStr," ")

For iCounter=0 to ubound(StrArray)
        print strreverse(StrArray(iCounter))
Next


‘**************************************************************************
'29    Print the data as a Pascal triangle
‘**************************************************************************
'The formulae for pascal triangle is nCr=n!/(n-r)!*r!

Dim PascalTriangleRows
Dim nCr
Dim NumCount
Dim RowCount

PascalTriangleRows = 10
For NumCount = 0 To PascalTriangleRows
    toPrint= Space(PascalTriangleRows - NumCount)
    For RowCount = 0 To NumCount
            If (NumCount = RowCount) Then
                    nCr = 1
            Else
                nCr = Factorial(NumCount) / (Factorial(NumCount - RowCount) * Factorial(RowCount))
            End If
     toPrint=toPrint&nCr&" "
    Next
    print toPrint
Next


Function Factorial(num)
   Dim iCounter
    Factorial = 1
    If num <> 0 Then
        For iCounter = 2 To num
            Factorial = Factorial * iCounter
        Next
    End If
End Function

‘**************************************************************************
'30    Join elements of an array as a string
‘**************************************************************************

Dim oStr
Dim iCounter
oStr="Quick Test Professional"
StrArray=split(oStr," ")

print join(StrArray," ")


‘**************************************************************************
'31    Trim a given string from both sides
‘**************************************************************************

Dim oStr

oStr="    QTP    "
print trim(oStr)


‘**************************************************************************
'32    Write a program to insert 100 values and to delete 50 values from an array
‘**************************************************************************

Dim oArray()
Dim iCounter

ReDim oArray(100)

For iCounter=0 to ubound(oArray)
            oArray(iCounter)=iCounter
            'Print total 100 Values
            print(oArray(iCounter))
Next
print "******************************"
print "******************************"
ReDim preserve oArray(50)

For iCounter=0 to ubound(oArray)
    'Print Values after deleting 50 values
            print(oArray(iCounter))
Next

‘**************************************************************************
'33    Write a program to force the declaration of variables
‘**************************************************************************

Option explicit    ' this keyword will enforce us to declare variables

Dim x
x=10
'Here we get an error because i have not declared y,z
y=20
z=x+y
print z

‘**************************************************************************
'34    Write a program to raise an error and print the error number.
‘**************************************************************************

On Error Resume Next
Err.Raise 6   ' Raise an overflow error.
print  ("Error # " & CStr(Err.Number) & " " & Err.Description)


‘**************************************************************************
'35    Finding whether a variable is an Array
‘**************************************************************************

Dim oArray()

if  isarray(oArray) then
    print "the given variable is an array"
 else
    print "the given variable is not an array"
End if

‘**************************************************************************
'36    Write a program to list the Time zone offset from GMT
‘**************************************************************************
Dim objWMIService
Dim colTimeZone
Dim objTimeZone

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colTimeZone = objWMIService.ExecQuery("Select * from Win32_TimeZone")

For Each objTimeZone in colTimeZone
    print "Offset: "& objTimeZone.Bias
Next

‘**************************************************************************
'37 Retrieving Time Zone Information for a Computer
‘**************************************************************************
Dim objWMIService
Dim colTimeZone
Dim objTimeZone

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colTimeZone = objWMIService.ExecQuery("Select * from Win32_TimeZone")

For Each objItem in colTimeZone

    print "Bias: " & objItem.Bias
    print "Caption: " & objItem.Caption
    print "Daylight Bias: " & objItem.DaylightBias
    print "Daylight Day: " & objItem.DaylightDay
    print "Daylight Day Of Week: " & objItem.DaylightDayOfWeek
    print "Daylight Hour: " & objItem.DaylightHour
    print "Daylight Millisecond: " & objItem.DaylightMillisecond
    print "Daylight Minute: " & objItem.DaylightMinute
    print "Daylight Month: " & objItem.DaylightMonth
    print "Daylight Name: " & objItem.DaylightName
    print "Daylight Second: " & objItem.DaylightSecond
    print "Daylight Year: " & objItem.DaylightYear
    print "Description: " & objItem.Description
    print "Setting ID: " & objItem.SettingID
    print "Standard Bias: " & objItem.StandardBias
    print "Standard Day: " & objItem.StandardDay
    print "Standard Day Of Week: " & objItem.StandardDayOfWeek
    print "Standard Hour: " & objItem.StandardHour
    print "Standard Millisecond: " & objItem.StandardMillisecond
    print "Standard Minute: " & objItem.StandardMinute
    print "Standard Month: " & objItem.StandardMonth
    print "Standard Name: " & objItem.StandardName
    print "Standard Second: " & objItem.StandardSecond
    print "Standard Year: " & objItem.StandardYear
   
Next


‘**************************************************************************
'38    Write a program to Convert an expression to a date
‘**************************************************************************
Dim StrDate
Dim actualDate
Dim StrTime
Dim actualTime

StrDate = "October 19, 1962"   ' Define date.
actualDate = CDate(StrDate)   ' Convert to Date data type.
print actualDate
StrTime = "4:35:47 PM"         ' Define time.
actualTime = CDate(StrTime)   ' Convert to Date data type.
print actualTime


‘**************************************************************************
'39 Display current date and Time
‘**************************************************************************

print now

‘**************************************************************************
'40    Find difference between two dates.
‘**************************************************************************

'Date difference in Years
print DateDiff("yyyy","12/31/2002",Date)

'Date difference in Months
print DateDiff("m","12/31/2002",Date)

'Date difference in Days
print DateDiff("d","12/31/2002",Date)


‘**************************************************************************
'41    Add time interval to a date
‘**************************************************************************

print DateAdd("m", 1, "31-Jan-95")


‘**************************************************************************
'42    Print current day of the week
‘*************************************************************************
Print day(date)
‘**************************************************************************
'43    Find whether current month is a long month
‘**************************************************************************
Dim oCurrentMonth
Dim ocurrentYear
Dim oDaysinMonths

oCurrentMonth = Month(date)
ocurrentYear = Year(date)
oDaysinMonths=Day(DateSerial(ocurrentYear, oCurrentMonth + 1, 0))
print oDaysinMonths&" Days in Current Month"
If oDaysinMonths=31 Then
    print "Current Month is a long month"
else
    print "Current Month is not a long month"
End If

‘**************************************************************************
'44    Find whether given year is a leap year
‘**************************************************************************

'1st Method

'The rules for leap year:
'1. Leap Year is divisible by 4    (This is mandotory Rule)
'2. Leap Year is not divisible by 100 (Optional)
'3. Leap Year divisble by 400 (Optional)

Dim oYear

oYear=1996

If ((oYear Mod 4 = 0) And (oYear Mod 100 <> 0) Or (oYear Mod 400 = 0)) then
    print "Year "&oYear&" is a Leap Year"
else
    print "Year "&oYear&" is not a Leap Year"
End If

‘**************************************************************************
'45.    2nd Method
' Checking 29 days for February month in specified year
‘**************************************************************************
Dim oYear
Dim tmpDate

oYear=1996
tmpDate = "1/31/" & oYear
DaysinFebMonth = DateAdd("m", 1, tmpDate)

If  day(DaysinFebMonth )=29 then
    print "Year "&oYear&" is a Leap Year"
else
    print "Year "&oYear&" is not a Leap Year"
End If


‘**************************************************************************
'46    Format Number to specified decimal places
‘**************************************************************************

Dim oNum
Dim DecimaPlacestobeFormat
oNum = 3.14159
DecimaPlacestobeFormat=2
print Round(oNum , DecimaPlacestobeFormat)


‘**************************************************************************
'47    Write a program to Generate a Random Numbers
‘**************************************************************************
'This script will generate random numbers between 10 and 20
Dim rStartRange
Dim rEndRange

rStartRange=10
rEndRange=20

For iCounter=1 to 10
    print Int((rEndRange - rStartRange + 1) * Rnd + rStartRange)
Next

‘**************************************************************************
'48    Write a program to show difference between Fix and Int
'Both Int and Fix remove the fractional part of number and return the resulting integer value.
'The difference between Int and Fix is that if number is negative, Int returns the first negative integer less than or equal to number,
'whereas Fix returns the first negative integer greater than or equal to number.
'For example, Int converts -8.4 to -9, and Fix converts -8.4 to -8.
‘**************************************************************************

print Int(99.8)    ' Returns 99.
print Fix(99.2)    ' Returns 99.
print Int(-99.8)   ' Returns -100.
print Fix(-99.8)   ' Returns -99.
print Int(-99.2)   ' Returns -100.
print Fix(-99.2)   ' Returns -99.


‘**************************************************************************
'49    Write a program to find subtype of a variable
‘**************************************************************************

Dim oVar
Dim oDatatypes
oVar="QTP"
oVartype=Typename(oVar)
print oVartype


‘**************************************************************************
'50    Write a program to print the decimal part of a given number
‘**************************************************************************
Dim oNum
oNum=3.123
oDecNum=oNum- int(oNum)
print oDec
‘**************************************************************************
'51    Moving / Renaming of Files to a different location.

‘**************************************************************************
Dim fso,f
Var_Path = "Source Path"
Var_NewPath = "Destination Path"
Set fso= CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(Var_Path)
For Each file In f.Files
                            'SourcePath                    File Name                Extention, Destination Path                 NewfileName                  Extension
     fso.MoveFile  Var_Path & "\" & DataTable("Old", dtGlobalSheet)&".doc", Var_NewPath  & "\" & DataTable("New", dtGlobalSheet) &".doc"
     DataTable.GetSheet("Global").SetNextRow
Next
Set f = Nothing
Set fso = Nothing
‘**************************************************************************
'52  List the Documents in a Excel for a given folder

‘**************************************************************************
Dim fso,f,i
Dim objexcel
Var_Path = "C:\Sudhindra\TestFolder"
Set fso= CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(Var_Path)
Set objExcel = CreateObject("Excel.Application")
objexcel.Visible = True
objexcel.Workbooks.add
 i=2
objexcel.Cells(1, 1).Value = "File Name"
For Each file In f.Files

        var_Name = file.Name
  Var_Test = Instr(1, var_Name, ".doc") 'Only Saves Documents in a excel.
  If  Var_Test Then
   var_Name = Split(var_Name, ".doc")
    objexcel.Cells(i, 1).Value = var_Name(0)
     i = i + 1
  End If
   
Next
objexcel.ActiveWorkbook.SaveAs(Var_Path & "\Files.xls")
objexcel.Quit
Set f = Nothing
Set fso = Nothing
Set objexcel = Nothing
‘**************************************************************************
'53  Date Manipulation according to desired format

‘**************************************************************************

Public Function ManipulateDate(strDate, DesiredFormat)

  Set MyDate = DotNetFactory.CreateInstance("System.DateTime")
  Set oDate = MyDate.Parse(strDate)
  ManipulateDate = oDate.ToString("DesiredFormat")'like MM/dd/yyyy
  Set MyDate = Nothing

End Function 
‘**************************************************************************
'53 Creating word document and saving

‘**************************************************************************
set word = createobject("word.application")
set doc = word.documents.add
set selection = word.selection
selection.typetext "Automated Word document"
selection.typeparagraph
word.visible = true

doc.saveas("D:\testdoc.doc")

Set doc = nothing
 
‘**************************************************************************
'53 Invoke QTP thorugh vbs file.

‘**************************************************************************
Dim qtApp 'As QuickTest.Application ' Declare the Application object variable
Dim qtTest 'As QuickTest.Test ' Declare a Test object variable
Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object
qtApp.Launch ' Start QuickTest
Set fso = createobject("Scripting.FileSystemObject")
Strpath = fso.GetAbsolutePathName(".")
StrAbspath =  Strpath &"\"& "TEST DRIVER"
qtApp.Visible = True ' Make the QuickTest application visible
qtApp.Open StrAbspath, True ' Open the test in read-only mode
' set run settings for the test
Set qtTest = qtApp.Test
qtTest.Run ' Run the test

Set qtResultsOpt = Nothing ' Release the Run Results Options object
Set qtTest = Nothing ' Release the Test object
Set qtApp = Nothing ' Release the Application object
Set fso = Nothing

‘**************************************************************************
'53 Unlock system for a specific period of time

‘**************************************************************************
IntInput = inputbox ("Enter the number of HOURS to keep your PC unlocked ")
Const DELAY_Minutes = 1
Mins=0

Do while cdbl(Mins/60) < cdbl(IntInput)
  CreateObject("Wscript.Shell").SendKeys "^"
   Wscript.Sleep DELAY_Minutes * 60000
   Mins=Mins+1
Loop

'------------------------------------------------------------------------------------------------------------------------------------------
'Function to create  a tracker
'------------------------------------------------------------------------------------------------------------------------------------------
Public Function CreateTracker(StrTitle, ntimeout)
    Dim Strcontent
    Dim counter
    Dim WshShell
    ncounter = 0
    Set ObjTracker = CreateObject("internetExplorer.application")
    ObjTracker.navigate ("about:blank")
    Do
        '    wscript.sleep 10
        Wait 2
    Loop Until ObjTracker.readyState = 4
    ObjTracker.fullScreen = True
    ObjTracker.Toolbar = False
    ObjTracker.StatusBar = False
    ObjTracker.addressBar = False
    ObjTracker.resizable = True
    ObjTracker.Width = 300
    ObjTracker.Height = 150
    ObjTracker.Top = 300
    With ObjTracker.document.ParentWindow.Screen
        ObjTracker.Left = (.AvailWidth - ObjTracker.Width) \ 2
        '   ObjTracker.Top  = (.Availheight - ObjTracker.height) \ 2
    End With
    '=========================================
    'Generate the layout of the Tracker
    Strcontent = ""
    Strcontent = "<html border-style=""none"" border-width=""0px"">"
    Strcontent = Strcontent & "<head><title>" & StrTitle & "</title>"
    Strcontent = Strcontent & "<script language=""vbscript"">" & vbCrLf
    Strcontent = Strcontent & " Dim ncounter,intervalID" & vbCrLf
    Strcontent = Strcontent & " ncounter = 0" & vbCrLf
    Strcontent = Strcontent & "Function ResetCounter()" & vbCrLf
    Strcontent = Strcontent & "ncounter = 0" & vbCrLf
    Strcontent = Strcontent & "End Function" & vbCrLf
    Strcontent = Strcontent & " function onquit()" & vbCrLf
    Strcontent = Strcontent & " wscript.quit" & vbCrLf
    Strcontent = Strcontent & " end function" & vbCrLf
    Strcontent = Strcontent & " function fnScroll()" & vbCrLf
    Strcontent = Strcontent & " document.title = Right(document.title,len(document.title)-1) & Left(document.title,1) " & vbCrLf
    Strcontent = Strcontent & "End  Function" & vbCrLf
    Strcontent = Strcontent & "window.setInterval ""fnScroll()"",500" & vbCrLf
    If ntimeout > 0 Then
        Strcontent = Strcontent & "Public Function TriggerRecovery()" & vbCrLf
        Strcontent = Strcontent & "ncounter = ncounter + 1" & vbCrLf
        Strcontent = Strcontent & "if ncounter > " & ntimeout & " then" & vbCrLf
        'Strcontent = Strcontent & "msgbox ncounter" &VBcrlf
        Strcontent = Strcontent & "ncounter = 0" & vbCrLf
        Strcontent = Strcontent & "Set WshShell = CreateObject(""wscript.Shell"")" & vbCrLf
        Strcontent = Strcontent & "WshShell.Run(""" &StrRecoveryFilePath&""")" &VBcrlf
        Strcontent = Strcontent & "Set WshShell = nothing" & vbCrLf
        Strcontent = Strcontent & "call SendEmail()" & vbCrLf
        Strcontent = Strcontent & "window.clearInterval(intervalID)" & vbCrLf
        Strcontent = Strcontent & "End IF " & vbCrLf
        Strcontent = Strcontent & "End Function " & vbCrLf
        Strcontent = Strcontent & "intervalID=window.setInterval(""TriggerRecovery()"",60000)" & vbCrLf
        Strcontent = Strcontent & "Private Function SendEmail()" & vbCrLf
        Strcontent = Strcontent & "Dim objMailApp" & vbCrLf
        Strcontent = Strcontent & "Dim objNewMail" & vbCrLf
        Strcontent = Strcontent & "Set objMailApp = CreateObject(""Outlook.Application"")" & vbCrLf
        Strcontent = Strcontent & "Set objNewMail = objMailApp.CreateItem(0)" & vbCrLf
        'Strcontent = Strcontent & "objNewMail.To = """& Environment.Value("EmailAddr")  &"""" &VBcrlf
        Strcontent = Strcontent & "objNewMail.Subject = """ & StrTitle & " - " & Date & """" & vbCrLf
        Strcontent = Strcontent & "objNewMail.HtmlBody = ""<html><body><basefont face='Trebuchet MS' size='2' color='red'><center> <B> GTAF - TRACKER </B><br> SLA timeout Reached......!!!<br><br> Script taking too much time for execution.... !!!<br><br> Inactivity observed for " & ntimeout & " minute(s).....!!!<br> Initaiting Tracker recovery.. ..<br> Quitting Goman instances...!!!</body></html> """ & vbCrLf
        Strcontent = Strcontent & "objNewMail.Send " & vbCrLf
        Strcontent = Strcontent & "Set objNewMail = Nothing " & vbCrLf
        Strcontent = Strcontent & "Set objMailApp = Nothing " & vbCrLf
        Strcontent = Strcontent & "End Function " & vbCrLf
    End If
    Strcontent = Strcontent & "</script></head>" & vbCrLf
    Strcontent = Strcontent & "<body  text-align=""center""  style=""color:blue ; font-size: x-small; outline:0 ; border:2px solid blue;margin:0"" scroll=""no"" onclick=""vbscript:Close"">" & vbCrLf
    'Strcontent = Strcontent &  StrTitle  & VBcrlf
    Strcontent = Strcontent & "<table style=""margin:0""><tr><td style=""width:33px""><span style=""color:green""  id=""passcnt""> </span></td>" & vbCrLf
    Strcontent = Strcontent & "<td style=""width:33px""><span id=""failcnt""  style=""color:red""> </span></td>" & vbCrLf
    Strcontent = Strcontent & "<td style=""width:33px""><span id=""Tcnt""  style=""color:black""> </span></td>" & vbCrLf
    Strcontent = Strcontent & "<td style=""width:200px""><span id=""test"" style=""color:Blue; font-size:x-small ;font-family:""Trebuchet MS""""> </span></td></tr></table>"
    'Strcontent = Strcontent & "<tr><td ><div id=""testcasename""> </div></td></tr> " &VBcrlf
    ' Strcontent = Strcontent & "<tr spancol=""2""><td > </td> </tr>" &VBcrlf
    Strcontent = Strcontent & "<hr style=""height:3px ; width:0px; color:green"" align=""left"" id=""bar"" />" & vbCrLf
    'Strcontent = Strcontent & "<tr><td><button id=""Close"" name=""Close"" onclick=""vbscript:Close"">Close</button></td></tr>" &VBcrlf
    Strcontent = Strcontent & "<div style=""position:absolute; left:65px; top:25px;font-size:11; color:660033""id=""perc"" font-family:""Trebuchet MS""></div></body></html>" & vbCrLf
    '=========================================
    ObjTracker.document.writeln (Strcontent)
    'wscript.sleep 100
    Wait 1
    CreateObject("WScript.Shell").AppActivate ("Internet Explorer")
    ObjTracker.Top = 300
    extern.Declare micLong, "SetWindowPos", "user32.dll", "SetWindowPos", micLong, micLong, micLong, micLong, micLong, micLong, micLong
    p = ObjTracker.document.ParentWindow.Screen.Height - 50
    retval = extern.SetWindowPos(ObjTracker.Hwnd, -1, 0, p, 123, 1015, 1)    ' move the window
    ' ObjTracker.width= 300
    ObjTracker.Height = 50
    ObjTracker.Width = 300
    With ObjTracker.document.ParentWindow.Screen
        ObjTracker.Left = (.AvailWidth - 325)
        '   ObjTracker.Top  = (.Availheight - ObjTracker.height) \ 2
    End With
    ObjTracker.Visible = True
    ObjTracker.document.getElementbyid("passcnt").innertext = "P:0"
    ObjTracker.document.getElementbyid("failcnt").innertext = "F:0"
    ObjTracker.document.getElementbyid("perc").innertext = "0%"
    '     msgbox err.description
End Function
'------------------------------------------------------------------------------------------------------------------------------------------
'Function to Show the tracker
'------------------------------------------------------------------------------------------------------------------------------------------
Public Function Show_Tracker(nPass, nFail, tcname, nPercent, delay)
    CreateObject("WScript.Shell").AppActivate ("Internet Explorer")
    'nPass = "T:" &  Environment("Test_TotalTC")  & nPass
    ObjTracker.document.getElementbyid("passcnt").innertext = " P:" & nPass
    ObjTracker.document.getElementbyid("failcnt").innertext = "F:" & nFail
    ObjTracker.document.getElementbyid("Tcnt").innertext = Environment("Test_TotalTC")
    ObjTracker.document.Title = ".....Tc:" & tcname & "...P:" & nPass & "..F:" & nFail & "  .."
    If nPercent > 0 And nPercent <> 0 Then
        nPercent = nPercent * 100
    End If
    '    ObjTracker.document.getElementbyid("bar").style.width= nPercent &"%"
    If Environment("TEST_LINK") <> "" Then
        Environment("Temp_TestCase") = Environment("TEST_LINK")
     End If
    If Environment("strTestName") = Environment("TEST_LINK") Then
        paramstring = Environment("strTestName")
    Else
        If Environment("TEST_LINK") = "" Then
            paramstring = Environment("strTestName") & "-" & Environment("Temp_TestCase")
        Else
            paramstring = Environment("strTestName") & "-" & Environment("TEST_LINK")
        End If
    End If
    ObjTracker.document.getElementbyid("perc").innertext = Int(nPercent) & "%" & ":    " & paramstring
    ObjTracker.document.getElementbyid("test").innertext = tcname
    ObjTracker.document.focus()
End Function
Call Show_Tracker(Environment("TP"), Environment("TF"), strStepKeyword, (Environment("TP") + Environment("TF")) / Environment("Test_TotalTC"), 22)
Call CreateTracker("p=0",22)         
ObjTracker.quit
 Set p = getref(Trim(strStepNameShort) & "_" & Trim(strStepKeyword))
                'Call Show_Tracker(    Environment("TP"),   Environment("TF"),strTestName & "-" &strStepNameShort & "_" & strStepKeyword & "-"& Environment("TEST_LINK")  ,    (Environment("TP")+ Environment("TF"))/total,22)
                Call p()

‘**************************************************************************
'    Working with internet explorer with vbs
‘**************************************************************************
        Sys_Username=""
        Sys_Password=""
        bullet = Chr(10) & "   " & Chr(149) & " "

    Do    
         response = InputBox("Please enter the number that corresponds to your selection:" & Chr(10) & bullet & "1.) Zensar webmail" & bullet & "2.) Zensoft" & bullet & "3.) JobCard" & bullet & "4.) PeopleSoft" & bullet & "5.) Zenlounge" & bullet & "6.) PaySquare "& Chr(10), "Select Thing")
          If IsNumeric(response) Then Exit Do   
          MsgBox "You must enter a numeric value.", 48, "Invalid Entry"
     Loop

    Set IE = CreateObject("InternetExplorer.Application")
        Set WshShell= CreateObject("WScript.Shell")

    If response =1 Then
          IE.Navigate "App1"
    ElseIf response =2 Then
          IE.Navigate "App2"
                Wscript.Sleep 500
        ElseIf response =3 Then
                IE.Navigate "App3"
        ElseIf response =4 Then
                IE.Navigate "App4"
    ElseIf response =5 Then
                IE.Navigate "App5"
    ElseIf response =6 Then
                IE.Navigate "App6"
    End If

        IE.Visible = True

        While IE.Busy
            Wscript.Sleep 500
        Wend

        If response =1 Then
          IE.Document.All.Item("Username").Value = ""
        IE.Document.All.Item("password").Value = ""
                IE.Document.All.Item("Submit").Click   
    ElseIf response =2 Then
          IE.Document.All.Item("user").Value = Sys_Username
        IE.Document.All.Item("password").Value = Sys_Password
        IE.Document.All.Item("btnLogin").Click
        ElseIf response =3 Then
                IE.Document.All.Item("staffId").Value = Sys_Username
        IE.Document.All.Item("password").Value = Sys_Password
                IE.Document.All.Item("button").Click
    ElseIf response =4 Then
        IE.Document.All.Item("userid").Value = ""
        IE.Document.All.Item("pwd").Value = ""
        IE.Document.All.Item("Submit").Click
                Wscript.Sleep 2500
                WshShell.SendKeys "{ENTER}"
        Wscript.Sleep 1000
                WshShell.SendKeys "{ENTER}"
                Wscript.Sleep 1000
                WshShell.SendKeys "{ENTER}"
                Wscript.Sleep 1000
                WshShell.SendKeys "{ENTER}"
        ElseIf response =5 Then
        IE.Document.All.Item("login").Value = Sys_Username
        IE.Document.All.Item("_58_password").Value = Sys_Password
            Set tags = IE.Document.GetElementsByTagname("Input")
         For Each tagx In tags 
               If tagx.value = "Submit" Then  
                    tagx.Click  
             End If
         Next
        ElseIf response =6 Then
        IE.Document.All.Item("txtloginid").Value = ""
        IE.Document.All.Item("txtpassword").Value = ""
        IE.Document.All.Item("ImgBtn_Login").Click
    End If
   
    WshShell.AppActivate "IE"
        Set IE=Nothing
        set WshShell=Nothing

‘**************************************************************************
'   Saving Clipboard data to a file
‘**************************************************************************

Dim StrPath,ObjWord,ObjFso,strFolderPath
strFolderPath = "C:\Users\Sprint\"
StrPath = strFolderPath & "\docname.docx"
set ObjWord = createobject("Word.application")
Set ObjFso = createObject("scripting.filesystemObject")
If not ObjFso.FolderExists(strFolderPath) then
ObjFso.CreateFolder(strFolderPath)
End If

If ObjFso.FileExists(StrPath) then
set Objdoc = ObjWord.documents.Open(StrPath)
Else
set Objdoc = ObjWord.documents.Add
End If
set selection = ObjWord.selection
selection.typeparagraph
Set Shell = CreateObject("WScript.Shell")
MsgBox "Please click on OK once the snap shot is saved.",,"Snap Shot saved confirmation window"
selection.EndKey 6,0
selection.typeparagraph
selection.Paste
Set Shell = Nothing
ObjWord.visible = false

Objdoc.saveas(StrPath)

Objdoc.Close
ObjWord.quit
Set Objdoc = nothing
set ObjWord =nothing
Set ObjFso =nothing

Set Shell = nothing

No comments:

Post a Comment

Different Types of Keyboard Inputs : Type, SendKeys & Device Replay

1. Most objects support the TYPE method.  Type will enter the specified string into an object or perform a certain keyboard combinat...