To Zip the folder using QTP

 To Zip the folder using QTP

Function ZipFolder( myFolder, myZipFile )
' This function recursively ZIPs an entire folder into a single ZIP file,
' using only Windows' built-in ("native") objects and methods.
'
' Arguments:
' myFolder   [string]  the fully qualified path of the folder to be ZIPped
' myZipFile  [string]  the fully qualified path of the target ZIP file
'
' Return Code:
' An array with the error number at index 0, the source at index 1, and
' the description at index 2. If the error number equals 0, all went well
' and at index 1 the number of skipped empty subfolders can be found.
'
' Notes:
' [1] If the specified ZIP file exists, it will be overwritten
'     (NOT APPENDED) without notice!
' [2] Empty subfolders in the specified source folder will be skipped
'     without notice; lower level subfolders WILL be added, wether
'     empty or not.

    Dim objApp, objFolder, objFSO, objItem, objTxt
    Dim strSkipped
    Const ForWriting = 2
    intSkipped = 0
    ' Make sure the path ends with a backslash
    If Right( myFolder, 1 ) <> "\" Then
        myFolder = myFolder & "\"
    End If
    ' Use custom error handling
    On Error Resume Next
    ' Create an empty ZIP file
    Set objFSO = CreateObject( "Scripting.FileSystemObject" )

 If  objFSO.FileExists(myZipFile)Then
        objFSO.DeleteFile myZipFile, True
 End If

    Set objTxt = objFSO.OpenTextFile( myZipFile, ForWriting, True )
    objTxt.Write "PK" & Chr(5) & Chr(6) & String( 18, Chr(0) )
    objTxt.Close
    Set objTxt = Nothing
    ' Abort on errors
    If Err Then
        ZipFolder = Array( Err.Number, Err.Source, Err.Description )
        Err.Clear
        On Error Goto 0
        Exit Function
    End If
   
    ' Create a Shell object
    Set objApp = CreateObject( "Shell.Application" )
    ' Copy the files to the compressed folder
    For Each objItem in objApp.NameSpace( myFolder ).Items
        If objItem.IsFolder Then
            ' Check if the subfolder is empty, and if
            ' so, skip it to prevent an error message
            Set objFolder = objFSO.GetFolder( objItem.Path )
            If objFolder.Files.Count + objFolder.SubFolders.Count = 0 Then
                intSkipped = intSkipped + 1
            Else
                objApp.NameSpace( myZipFile ).CopyHere objItem
            End If
        Else
            objApp.NameSpace( myZipFile ).CopyHere objItem
        End If
    Next
    Set objFolder = Nothing
    Set objFSO    = Nothing
    ' Abort on errors
    If Err Then
        ZipFolder = Array( Err.Number, Err.Source, Err.Description )
        Set objApp = Nothing
        Err.Clear
        On Error Goto 0
        Exit Function
    End If
    ' Keep script waiting until compression is done
    intSrcItems = objApp.NameSpace( myFolder  ).Items.Count
    Do Until objApp.NameSpace( myZipFile ).Items.Count + intSkipped = intSrcItems
        WScript.Sleep 200
    Loop
    Set objApp = Nothing
    ' Abort on errors
    If Err Then
        ZipFolder = Array( Err.Number, Err.Source, Err.Description )
        Err.Clear
        On Error Goto 0
        Exit Function
    End If
    ' Restore default error handling
    On Error Goto 0
    ' Return message if empty subfolders were skipped
    If intSkipped = 0 Then
        strSkipped = ""
    Else
        strSkipped = "skipped empty subfolders"
    End If
    ' Return code 0 (no error occurred)
    ZipFolder = Array( 0, intSkipped, strSkipped )
End Function

Ex:
Call ZipFolder( "C:\SOS_Optus\PIT Automation\PITSceanrios\PIT_Portal_007", "C:\SOS_Optus\PIT Automation\PITSceanrios\PIT_Portal_007.zip" )

Capture Test Step in QTP

Capture Test Step in QTP

Public Function Add_Attachment_Step(FilePath)
Set MyStep = qcutil.CurrentRun.StepFactory.AddItem(null)
MyStep.Field("ST_STEP_NAME")="My Step "
MyStep.Field("ST_STATUS") = "Failed"
MyStep.Field("ST_DESCRIPTION") = "My Step Description"
MyStep.Field("ST_EXPECTED") = "My Step Expected Result"
MyStep.Field("ST_ACTUAL") = "My Step Actual Result"
MyStep.Post
set oStepsList = QCUtil.CurrentRun.StepFactory.NewList("")
'get the Count of steps
iStepCount = oStepsList.Count
'Now can add the attachment to the recently added step
Set ObjCurrentTest = QCUtil.CurrentRun.StepFactory.NewList("").Item(iStepCount)
Set Attachment_Factory = ObjCurrentTest.attachments
Set ObjAttach = Attachment_Factory.AddItem(null)
ObjAttach.Filename = FilePath
ObjAttach.Type=1
ObjAttach.Post
ObjAttach.Refresh
Set oStepsList  = nothing
Set ObjCurrentTest = nothing
Set Attachment_Factory = nothing
Set ObjAttach = nothing
Set MyStep = nothing
End Function

Launching Internet Explorer Using QTP

Launching Internet Explorer Using QTP

Public Function launchIE()
   Dim oShell
Set Controller = CreateObject("WScript.Network")
        SysName=Controller.ComputerName
   UsrName=Controller.UserName
   If  Trim(SysName)=Environment("SYS_HOST") Then
  InvokeApplication "M:\Program Files\Internet Explorer\IEXPLORE.EXE"
    'SystemUtil.Run "M:\Program Files\Internet Explorer\IEXPLORE.EXE","","M:\Documents and Settings\"&UsrName ,"open"
   'SystemUtil.Run Environment("SYS_PATH") + "Internet Explorer\iexplore.exe","","","open"
      Else
   SystemUtil.Run "iexplore.exe","","","open"
   End If
End Function

Kill Browser Function Using QTP or VB Script

Kill Browser Function Using QTP or VB Script

Function Kill_Browser_Processes()
       Do while Browser("micclass:=Browser", "index:=0").Exist
              sBrowserTitle = "Mercury TestDirector 8.0 SP2"
              sBrowserName = Browser("micclass:=Browser", "index:=0").GetROProperty ("title")
             If Instr (sBrowserName, sBrowserTitle)  Then
                  Do while Browser("micclass:=Browser", "index:=1").Exist
       'To close any unwanted popups
       If Browser("Optus Online Store").Dialog("Microsoft Internet Explorer").Exist(0) Then
        Browser("Optus Online Store").Dialog("Microsoft Internet Explorer").WinButton("OK").Click
       End If
      
                      sBrowserName = Browser("micclass:=Browser", "index:=1").GetROProperty ("title")
                         If Instr (sBrowserName, sBrowserTitle) Then
                 Exit Do
                         Else
       'To close any unwanted popups
       If Browser("Optus Online Store").Dialog("Microsoft Internet Explorer").Exist(0) Then
        Browser("Optus Online Store").Dialog("Microsoft Internet Explorer").WinButton("OK").Click
       End If
                             Browser("micclass:=Browser","index:=1").Close
                        End If
                 Loop
  
     Exit Do
           Else
     'To close any unwanted popups
       If Browser("Optus Online Store").Dialog("Microsoft Internet Explorer").Exist(0) Then
        Browser("Optus Online Store").Dialog("Microsoft Internet Explorer").WinButton("OK").Click
       End If
                 Browser("micclass:=Browser","index:=0").Close
           End If
       Loop
End Function

Check If Datasheet in a Excel Sheet Exists using VB Script

 Public Function IsDataSheetExist( sSheetName,sColumnName)
On Error Resume Next

  Val = DataTable(sColumnName,sSheetName)
  If Err.Number<> 0 Then
   IsDataSheetExist="False"
  Else
    IsDataSheetExist="True"  
  End If
 
End Function

Check If File Exists using VB Script

Check If File Exists using VB Script

Public Function  IfFileExist (sFilePath)
On Error Resume Next
    Set filesys = CreateObject("Scripting.FileSystemObject")
         If filesys.FileExists(sFilePath)="False" Then
     IfFileExist ="False"
    Else
       IfFileExist="True"
     End If
End Function

Creating Generic Click Button using Desriptive Programming

Creating Generic Click Button using Desriptive Programming

Public Function Click_Next(Field_Name,Button_Name)
 attrib_value = Get_Attribute_Value(Field_Name)
 Set IE = Browser("Optus - Intranet - Intranet").Page("Optus - Personal - Secure_Checkout_Your_Details").Object
 Set objElementButton =IE.GetElementsByTagName("FIELDSET")
 If Lcase(Field_Name) <> "delivery details"  Then
  For i=0 to objElementButton.Length-1
    attribOb=objElementButton.Item(i).getAttribute("id")   
    attribObj=trim(attribOb)
    If  attribObj = attrib_value Then
     Set objElementImage =objElementButton.Item(i).GetElementsByTagName("DIV")
      For j=0 to objElementImage.Length-1
         Set objElementImage1=objElementImage.Item(j).GetElementsByTagName("input")
           For k=0 to objElementImage1.Length-1
              attribObjtype=objElementImage1.Item(k).type
              If  attribObjtype = "image" Then
                 attribObjAlt=objElementImage1.Item(k).GetAttribute("alt")
                 If attribObjAlt = "Next" Then
                  objElementImage1.Item(k).click
                  Reporter.ReportEvent micDone,"Click_Next","Next is button is clicked"
                  Exit Function
                 End If
              End If
           Next 
      Next   
    End If
   Next
 Else
  Browser("Optus - Intranet - Intranet").Page("Optus - Personal - Secure_Checkout_Your_Details").Image("Class Name:= Image","Outerhtml:=.*generateDelvAddr().*").click
  Reporter.ReportEvent micDone,"Click_Next","Next is button is clicked"
 End If
 wait(15)
End Function

Clean up Excel Sheet Using Vb Script

Clean up Excel Sheet Using Vb Script

 Public  Function ExcelFileCleanup(fileName)
   Set ExcelObj = CreateObject("Excel.Application")
   ExcelObj.Visible = false
   ExcelObj.DisplayAlerts = False
   ExcelObj.Workbooks.Open(fileName)
   RowC = ExcelObj.ActiveSheet.UsedRange.Rows.Count
   If RowC >= 2 Then
   ' Note: row 1 in Excel file is the column header in the data table
   ' To delete row 2 of the data table is to delete row 3 in an Excel file
   ExcelObj.Rows("2:" &RowC).Select
   ExcelObj.Selection.Delete
   End If
   ExcelObj.ActiveWorkbook.Save
  
   ExcelObj.Quit

   ' Release created Objects
  
    Set ExcelObj = Nothing
End Function

Function To Create DictionaryObject using VB Script

Function To Create DictionaryObject using VB Script

Class DictionaryObj
    'The actual dictionary
    Private oDict
    'Private variable for storing value of AccessUsingIndex property
    Private mAccessUsingIndex
    'Now we need add all functions that the Dictionary already supports
    Public Property Get HashVal(Text)
        HashVal = oDict.HashVal(Text)
    End Property
    'Method to add a Key Value Pair
    Public Sub Add(ByVal Key, ByVal Item)
        oDict.Add Key, Item
    End Sub
    'Return the array of keys
    Public Function Keys()
        Keys = oDict.Keys
    End Function
    'Property to change key
    Public Property Let Key(oldKey, newKey)
        oDict.Key(oldKey) = newKey
    End Property
    'Returns array of items
    Public Function Items()
        Items = oDict.Items
    End Function
    'Check if certain key exists or not
    Public Function Exists(Key)
        Exists = oDict.Exists(Key)
    End Function
    'Remove All keys
    Public Sub RemoveAll()
        oDict.RemoveAll
    End Sub
    'Remove a specified key
    Public Sub Remove (Key)
        oDict.Remove GetKey(Key)
    End Sub
    'Get count of items in dictionary
    Public Property Get Count()
        Count = oDict.Count
    End Property
    'Get Property for CompareMode
    Public Property Get CompareMode()
        CompareMode = oDict.CompareMode
    End Property
    'Let Property for CompareMode
    Public Property Let CompareMode(newMode)
        oDict.CompareMode = newMode
    End Property
    'AccessUsingIndex is a flag which can be set to True/False If Set to True then Numeric Keys will be translated to index
    'values and there corresponding keys will be used.In case the numeric value is an existing key in the dictionary then it would not be translated
    Public Property Get AccessUsingIndex()
        AccessUsingIndex = mAccessUsingIndex
    End Property
    'Let property for AccessUsingIndex
    Public Property Let AccessUsingIndex(newValue)
        If newValue = True Or newValue = False Then
            mAccessUsingIndex = newValue
        Else
            'If anything other then True/False raise an error
            Err.Raise vbObjectError + 1, "DictionaryEx AccessUsingIndex can only be set true/false."
        End If
    End Property
    'Returns the actual dictionary object. This allows to do pass dictionary
    'to function which might support the actual dictionarty object
    Public Function Object()
        Set Object = oDict
    End Function
    'Function to translate keys from Index to actual key
    Private Function GetKey(Key)
        'Return actual key in case we are not
        'able to translate index to key
        GetKey = Key
        If Me.AccessUsingIndex Then
            'If the key already exist we do not want to change
            'anything even if it is a numeric value
            If Not oDict.Exists(Key) And IsNumeric(Key) Then
                keyIndex = CInt(Key)
                'Check if index is within range
                If keyIndex < Me.Count Then
                    Dim aKeys
                    aKeys = Me.Keys
                    'Translate from Index to Key
                    Key = aKeys(keyIndex)
                    Exit Function
                End If
            End If
        End If
    End Function
    'Item is the Default property for dictionary. So we need to use default keyword with Property Get
    'Default keyword can be used with a only one Function or Get Property
    Public Default Property Get Item(Key)
        'If a object is stored for the Key then we need to use Set to return the object
        If IsObject(oDict.Item(GetKey(Key))) Then
            Set Item = oDict.Item(GetKey(Key))
        Else
            Item = oDict.Item(GetKey(Key))
        End If
    End Property
    'Let property Item
    Public Property Let Item(Key, Value)
        'Check of the value is an object
        If IsObject(Value) Then
            'The value is an object, use the Set method
            Set oDict(GetKey(Key)) = Value
        Else
            'The value is not an object assign it
            oDict(GetKey(Key)) = Value
        End If
    End Property
    'Property Set Item
    Public Property Set Item(Key, Value)
        Set oDict(GetKey(Key)) = Value
    End Property
    'AddFromDictionary takes an actual dictionary object and add all keys from it
    Public Sub AddFromDictionary(oldDict)
        aKeys = oldDict.Keys
        Me.AccessUsingIndex = False
        For Each sKey In aKeys
            oDict(sKey) = oldDict(sKey)
        Next
    End Sub
    'LoadFromDictionary function removes all keys and then add the keys from dictionary. It is
    'equivalent of creating a clone from a existing dictionarty object
    Public Sub LoadFromDictionary(oldDict)
        oDict.RemoveAll
        Me.AddFromDictionary oldDict
    End Sub
    'Function to read dictionary key/value from file
    Public Sub AddFromFile(FileName, Delimiter)
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set oFile = Fso.OpenTextFile (FileName)
        'Read the file line by line
        While Not oFile.AtEndOfStream
            sLine = oFile.ReadLine
            KeyValue = Split(sLine, Delimiter)
            oDict(KeyValue(0)) = KeyValue(1)
        Wend
        Set oFile = Nothing
        Set FSO = Nothing
    End Sub
    'Function to remove all keys and then load it from
    'file
    Public Sub LoadFromFile(FileName, Delimiter)
        oDict.RemoveAll
        Me.AddFromFile FileName, Delimiter
    End Sub
    'Export the dictionarty to a file and use Delimiter
    'to seperate Key and Value pairs
    Public Sub ExportToFile(FileName, Delimeter)
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set oFile = FSO.CreateTextFile(FileName, True)
        Dim aKeys
        aKeys = oDict.Keys
        'Write the key value pairs line by line
        For Each sKey In aKeys
            oFile.WriteLine sKey & Delimeter & oDict(sKey)
        Next
        'Close the file
        oFile.Close
        Set oFile = Nothing
        Set FSO = Nothing
    End Sub
    'Intialize event gets executed whenever a object is created
    Sub Class_Initialize()
        Set oDict = CreateObject("Scripting.Dictionary")
        Me.AccessUsingIndex = False
    End Sub
    'Executed when the object is destroyed
    Sub Class_Terminate()
        'Remove all the keys
        oDict.RemoveAll
        'Destroy the dictionary
        Set oDict = Nothing
    End Sub
End Class
Public Function CreateDictionary()
    Set CreateDictionary = New DictionaryObj
End Function

Opening QTP and Running a Script and then Closing it Using VBS File

Opening QTP and Running a Script and then Closing it Using VBS File

'*********Opens the QTP and Runs the specified Script******************
Dim App 'As Application
Set App = CreateObject("QuickTest.Application")
App.Launch
App.Visible = True
App.Folders.Add("C:\Documents and Settings\Ayaskant Jena\Desktop\Vinay.qfl")
App.Folders.Add("C:\Documents and Settings\Ayaskant Jena\Desktop\Repository1.tsr")
App.Open "C:\Documents and Settings\Ayaskant Jena\Desktop\Ayas",False
App.Test.Run
'*************************WORKING FINE********************************
'**********Discards the present test and Close QTP*********************
Dim App 'As Application
Set App = CreateObject("QuickTest.Application")
App.quit
Set App = nothing
'*************************WORKING FINE*********************************

Creating Custom Report File

Creating Custom Report File
(Reference: CreateXML)
(See Previous Blog)
'*******************************************************************************************************************************************
'*  Function     : createCustomReportFile
'*******************************************************************************************************************************************
Function createCustomReportFile(ByVAL Desc)
 Desc = Desc & "->" & Now
 'Initializing the file system object
 Set objFile = createobject("Scripting.FileSystemObject")
 On Error Resume Next
 If objFile.FileExists(Environment.Value("REPORT_NAME"))  Then 
  Set customReport = XMLUtil.CreateXML()
  customReport.LoadFile Environment.Value("REPORT_NAME")
  Set root = customReport.GetRootElement()  
  Set TestSuite=root.ChildElements().Item(1)
 Else
  Call CreateXML()
  Set root = customReport.GetRootElement()
  root.AddChildElementByName "TestSuite",Desc
  Set TestSuite=root.ChildElements().Item(1)
  TestSuite.AddAttribute "startTime" ,cstr(Now)
  TestSuite.AddAttribute "Desc", Desc
 End If     
  
End Function

Creating XML Function Using QTP

'*******************************************************************************************************************************************
'*  Function     : CreateXML
'*******************************************************************************************************************************************
'Variable Declaration
Dim root
Dim BP
Dim TestSuite
Dim TestCase
Dim customReport
Public Function CreateXML()

 'Initializing the file system object
 Set objRootValue = createobject("scripting.FileSystemobject")
 Dim logFileName
 On Error Resume Next
 'Getting the root values for ITAA Custom XML report
 logFileName= "\\ittdevappw010\OPOM_Automation\Digital Life\DV_Portal_GlobalDataFiles\SUPPORT_FILES\testreport.txt"
 If Not objRootValue.FileExists(logFileName) Then
  fileMode = 2
  Set logfile = objRootValue.opentextfile(logFileName,filemode,True)
  logfile.writeLine("<?xml version='1.0'?>")
  logfile.writeLine("<?xml-stylesheet href= '\\ittdevappw010\OPOM_Automation\Digital Life\DV_Portal_GlobalDataFiles\SUPPORT_FILES\Report.xsl' type='text/xsl'?>")
  logfile.writeLine("<Report>")
  logfile.writeLine("</Report>")
  logfile.Close
 End If
 'Loading the  Custom XML report
 Set customReport = XMLUtil.CreateXML()
 customReport.LoadFile logFileName
 If Err.Number <> 0 Then   'Check the if there is an error
  Reporter.ReportEvent micFail,"CreateXML","XML file creation has failed"
  Environment.Value("ExecutionStatus")  = "Failed"
  Exit Function
 Else
  Reporter.ReportEvent micPass,"CreateXML","XML file creation has successfully done"
  Environment.Value("ExecutionStatus")  = "Passed"
 End If
End Function

To get the column and row count of Excel sheet

To get the column and row count of Excel sheet
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set ObjExcelFile1 = objExcel.Workbooks.Open("N:/Proton.xls")
Set ObjExcelSheet1 = ObjExcelFile1.Sheets("SOS_Mobile")
Row_Count = ObjExcelSheet1.UsedRange.Rows.Count
Column_Count = ObjExcelSheet1.UsedRange.Columns.Count
msgbox "Row Count is "&Row_Count& vbNewline &"Column Count is "&Column_Count
ObjExcelFile1.Close
objExcel.Quit

To change field values from one excel to other

To change field values from one excel to other

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set ObjExcelFile1 = objExcel.Workbooks.Open("D:ABCa.xls")
Set ObjExcelSheet1 = ObjExcelFile1.Sheets("Sheet1")
Set ObjExcelFile2 = objExcel.Workbooks.Open("D:ABCb.xls")
Set ObjExcelSheet2 = ObjExcelFile2.Sheets("Sheet1")
For i = 1 to ObjExcelSheet1.UsedRange.Rows.Count
 strValue = ObjExcelSheet1.Cells(i 8)
 ObjExcelSheet2.Cells(i 4) = strValue
 strValue1 = ObjExcelSheet1.Cells(i 11)
 ObjExcelSheet2.Cells(i 5) = strValue1
Next
ObjExcelFile2.Save
ObjExcelFile1.Close
ObjExcelFile2.Close
objExcel.Quit

Stop System from Hibernating..

Stop System from Hibernating..

Intcounter1=0
ans=InputBox("Enter Hours","Awake System",1)
If ans="" then
ans=1
End if
intend=ans*60*60
Do Until intCounter1>intend   '3600 '17280
Set WSHSHell=WScript.createObject("WScript.shell")
WScript.Sleep 5000
WSHSHELL.SendKeys  ("{SCROLLLOCK 2}")
If intCounter%1800 = 0 Then
  Set qtApp = CreateObject("QuickTest.Application") ' Create the application object
  qtApp.Launch() ' Start QuickTest
  qtApp.Visible = True' Make the QuickTest application visible
  qtApp.Options.Run.RunMode = "Fast"
  qtApp.Options.Run.ViewResults = False
  'If connection not already established then establish connection(QTP already running)
   If Not qtApp.TDConnection.IsConnected Then
      WScript.Echo("QC is not connected; Connecting to QC.")
      Call qtApp.TDConnection.Connect("http://tstpptappl002.optus.com.au:7001/qcbin", "IRTS-CMM", "TA420_SOS_R10_2", "vivek kaliyaperumal", "optus123", False)
   End If
   Dim objQTPTest 'As TestClass
   If qtApp.TDConnection.IsConnected Then ' If connection is successful 
      Dim strQCTestPath 'As String
      strQCTestPath = "[QualityCenter] Subject\SOS R10.2 / PVM / BB SIT\PPT Automation Regression\OPOM Mobile\dummy\Dataprep_Mobile_CV_1"
      WScript.Echo("Open test from QC: " & strQCTestPath)
      qtApp.Open strQCTestPath ,False ' Open test in read write mode
      Set qtTest = qtApp.test
      qtTest.Run
      qtTest.Close
      Err.Clear()
      On Error GoTo 0
   Else
      MsgBox("Cannot connect to Quality Center") ' If connection is not successful, display an error message.
   End If
   qtApp.TDConnection.Disconnect() ' Disconnect from Quality Center
   qtApp.Quit() ' Exit QuickTest
   Set qtApp = Nothing
   Set qtTest = Nothing
End If   
intCounter1=intCounter1+1
loop

Creating Checkbox using VB Scripts

Function SelectCheckBox(rootObj,chkNum) 
 On Error Resume Next
 Dim chkNumb
 chkNumb=Cint(chkNum)
 Set cDescCheckBox1= Description.Create
 cDescCheckBox1("type").value = "checkbox"
 cDescCheckBox1("html tag").value = "INPUT"
  'Set rootObject=Browser("Optus Online Store").Page("Optus Online Store").Frame("mainFrame")
   Set objCheck =  rootObj.ChildObjects(cDescCheckBox1)
  If objCheck.count >0 Then
                EnabledStatus=objCheck(chkNumb).getroproperty("disabled")
  Else
                Reporter.ReportEvent micFail,"Unable to retrieve check box items in the page","Extra features are not populated"
   End If

   If EnabledStatus=0 Then
        objCheck(chkNumb).set "ON"
        On Error GoTo 0
         If Err.Number<> 0 Then
               Reprter.reporter 1,"Unable to select checkbox","Either incorrect check box or check box is disabled"
               Err.Clear
         End If       Wait(3)
   End If

End Function

Capturing Screenshot and Saving with Timestamp

Capturing Screenshot and Saving with Timestamp

  Dim ScreenName
  On Error Resume Next
  ScreenName = ""

  CurrentTime = "_Test_Case"&"_"& Day(Now)&"_"& Month(Now)&"_"& Year(Now)&"_"& Hour(Now)&"_"& Minute(Now)&"_"& Second(Now)
  'Set the screen shot name
  ScreenShotName = "Screenshot" &  CurrentTime & ".png"
  'Final screenshot location
  ScreenName ="C:\Documents and Settings\Pankaj Kumar Ocmpf\Desktop\New Folder (2)"&"\"&ScreenShotName
  ' just capture
  Desktop.CaptureBitmap ScreenName,True 
******************************************************************
Public Function ScreenCapture()
Dim vNow, vFile
vNow = Replace(Replace(Replace(now(),":","_"),"/","_")," ","_")
vfile ="\\Cd102162\SOS_Optus\ "&vNow&".png"
'Capture Browser Scrren shot
Browser("micclass:=Browser").FullScreen
Browser("micclass:=Browser").CaptureBitmap vFile, True
' Add the Captured Screen shot to the Results file
Reporter.ReportEvent micDone,"Screen Shot","&lt;<img src='" &vFile& "'>&gt;"
End Function

Creating a Random String Using VB Script

Function RandomString( ByVal strLen )        Dim str
       Const LETTERS = "abcdefghijklmnopqrstuvwxyz"
       For i = 1 to strLen
                   str = str & Mid( LETTERS, RandomNumber( 1, Len( LETTERS ) ), 1 )   
       Next         RandomString = str
  End Function

To find the specified string in Notepad using VB Scripting

To find the specified string in Notepad using VB Scripting

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("N:/Wireline ECC.txt", 1)
line_num = 0
Do Until objFile.AtEndOfStream
    strLine = objFile.ReadLine
    msgbox( strLine)
    line_num = line_num+1
         If  instr(1,strLine,"Online")<> 0 Then
               MyPos = instr(1,strLine,"Online")
               Msgbox "Line No: " &line_num& " Position: "&MyPos
        End If
Loop
objFile.Close
objFSO = nothing
objFile = nothing

Creating a Text File and Appending Texts in the file Using VB Script

Creating a Text File and Appending Texts in the file Using VB Script:

Public Function  updateLogsFile(Information,Message)
 strLogFilePath = "\\tstgnpappw001\IVS_ Automation\Project THOR\Statistics\Log File.txt"
 Set fso = CreateObject("Scripting.FileSystemObject")
 Time_Stamp = "| " &now& " | " &Information &" | " &Message & " |"

 If fso.FileExists(strLogFilePath) Then
    Set ts = fso.Opentextfile(strLogFilePath,8)
    ts.WriteLine ""&Time_Stamp
 Else
    Set Text = fso.CreateTextFile(strLogFilePath)
        Text.WriteLine ""&Time_Stamp
 End If

 Set ts = Nothing
 Set fso = Nothing

End Function