Handling multi-dimensional array in vbscript

Was trying to build excel data provider, which can be used for Test Complete and QTP scripts. Created a VBScript to keep all excel contents into a multi-dimensional array.

Problem
Declared array with lower limits and then used ReDim to fix with right count. But I was able to retrieve the data only upto the initial array size.

Solution:
Tried different ways. Then declared array without any size as given in below code.

Code:

'-------------------------------------------------------------------------
' File     :   ExcelReadByArrays.vbs
' Author    :   PalaniSelvam Thillaiappan
' Purpose   :   To read the given sheet contents .
'-------------------------------------------------------------------------
'' Usage
'' cscript D:\MyCode\qtp_uft\ExcelReadByArrays.vbs 
'' test data: D:\MyCode\qtp_uft\testMyApp_1.xlsx
'******** Variables Declaration

Dim gsExcelFile, giStartRow, giStartCol, giEndRow, giEndCol, giSheetIndex
Dim gsLogFile
Dim arrExcelData() 'as all Rows data
'''Dim arrExcelData(5, 5) 'as all Rows data


giSheetIndex = 1
gsExcelFile = "D:\MyCode\qtp_uft\testMyApp_1.xlsx"


'' Working fine, but array size should be given properly
ExcelDataRead gsExcelFile, giSheetIndex, arrExcelData
PrintArrays arrExcelData

'--------------------------------------
' Method    :   ExcelDataRead
' Author    :   PalaniSelvam Thillaiappan
' Purpose   :   Read all the contents from Excel sheet and write into log file
' Parameters:   sExcelFile - String, contains the Excel file
'      :  iSheetIndex - Integer, Value for Sheet Index
'--------------------------------------
Sub ExcelDataRead(sExcelFile, iSheetIndex, ByRef arrExcel)
 Dim sExcelPath 'As Variant  'Excel file
 '********** Excel object declaration **********'
  ' Excel Application object
 Dim objExcel 'As Excel.Application
 Dim objXLWorkbooks 'As Excel.Workbooks
 Dim objXLWorkbook 'As Excel.Workbook

 Dim WorkSheetCount 'As Variant  'Work sheets count in a excel
 Dim CurrentWorkSheet 'As Excel.Worksheet    ' Current worksheet
 Dim objCells 'As Excel.Range
 Dim objCurrentCell 'As Variant
 Dim objFont 'As Variant

 ' Result contents
 Dim sCellText 'As Variant
 Dim sFontName 'As Variant
 Dim sFontStyle 'As Variant
 Dim iFontSize 'As Variant
 Dim iCellTextColorIndex 'As Variant
 Dim iCellInteriorColorIndex 'As Variant
 Dim sResult 'As Variant
 Dim sChartFile 'As String


 ' Row and Col integer variables
 Dim iUsedRowsCount 'As Integer
 Dim iUsedColsCount 'As Integer
 Dim iTop, iLeft 'As Integer
 Dim iRow 'As Integer     'Row item
 Dim iCol 'As Integer     'Col item
 Dim iCurRow 'As Integer
 Dim iCurCol 'As Integer
 Dim arrColList 'As Array - Column Name

 If (sExcelFile = "") Then
   sExcelPath = "D:\MyCode\qtp_uft\testMyApp_1.xlsx"
 Else
   sExcelPath = sExcelFile
 End If

 If (iSheetIndex = "") Then
  iSheetIndex = 2
 End If

 Set objExcel = CreateObject("Excel.Application")
 objExcel.Workbooks.Open sExcelPath, False, True

 On Error Resume Next

 WorkSheetCount = objExcel.Worksheets.Count

 Set objXLWorkbook = objExcel.ActiveWorkbook
 'objXLWorkbook.RunAutoMacros

 Set CurrentWorkSheet = objExcel.ActiveWorkbook.Worksheets(iSheetIndex) 'iSheetIndex worksheet

 iUsedRowsCount = CurrentWorkSheet.UsedRange.Rows.Count
 iUsedColsCount = CurrentWorkSheet.UsedRange.Columns.Count
 iTop = CurrentWorkSheet.UsedRange.Row
 iLeft = CurrentWorkSheet.UsedRange.Column

 CurrentWorkSheet.UsedRange.Columns.AutoFit()
 ' Cells object
 CurrentWorkSheet.Cells.Activate
 
 ReDim Preserve arrExcel(iUsedRowsCount, iUsedColsCount)
    ''ReDim arrColList(iUsedColsCount)


 For iRow = iTop To iUsedRowsCount   '(iUsedRowsCount - 1)
 
   'Read All Columns
   For iCol = iLeft To iUsedColsCount  '(iUsedColsCount - 1)

     sResult = ""
     Set objCurrentCell = CurrentWorkSheet.Cells(iRow, iCol)
     sCellText = objCurrentCell.Text
     sResult = "Reading Cell {" & CStr(iRow) & ", " & CStr(iCol) & "}^" & sCellText & "^" 
     WScript.echo sResult
     Set objCurrentCell = Nothing
     arrExcel (iRow-1, iCol-1) = sCellText
   Next

 Next
  
 ' This will prevent Excel from prompting us to save the workbook.
 objExcel.ActiveWorkbook.Saved = True
 Set CurrentWorkSheet = Nothing

 'objExcel.Worksbooks.Close
 objExcel.Quit

 ''Set CurrentWorkSheet = Nothing
 Set objExcel = Nothing


 'MsgBox "Read Completed.", vbOKOnly, "Exec Over"
 Exit Sub

 ErrorHandler1:
 'MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description
 'Err.Clear   ' Clear the error.

End Sub

'' To display given array
Sub PrintArrays( arrList)
'' To Print all list items
Dim aValue      'array item ==> dictionary
Dim aItem       'dictionaly item ==> key-pair value
Dim iRow
Dim iCol


     WScript.echo "Array Rows Count: ",UBound (arrList, 1)  '' First Array
     WScript.echo "Array Columns Count: ",UBound (arrList, 2) ''Second Array


    For iRow =LBound(arrList) to UBound (arrList)-1

       For iCol=LBound(arrList,2) to UBound (arrList,2)-1
         aValue = arrList(iRow, iCol)

         WScript.echo iRow, iCol, " Value:", aValue

        Next

    Next


End Sub

Class concept in VBScript

In VB, Classes can be created using Class Module. Basic Module files are used to have user-defined procedures and variables. Many of the VB Scripts are designed by structure programming.

Using VBScript, one can apply OOPs based scripting also. Initalizing code should be added in Class_Initialize procedure. Similarly terminating code should be added into Class_Terminate procedure. Below I've given a sample VBS code for class implementation.

Sample code from Net: VBScript Class to Send Mail With CDOSYS
Sample VBS code for CLASS implementation

''  UtilClass.vbs
' Purpose: To illustrate Class concept in VBScript

Class StringLib

 Private Sub Class_Initialize 
  ' Class initialization
  
   MsgBox "Initializing StringLib class"

 End Sub 

 Private Sub Class_Terminate 
  ' Class termination -end of life
    MsgBox "Terminating StringLib class"
 End Sub 

 ' Purpose   :   Checks the given file is avialable or not.
 Function FileExists(strPathName)
     Dim ObjFSO

     Set ObjFSO = CreateObject("Scripting.FileSystemObject")

     If ObjFSO.FileExists(strPathName) = False Then
       FileExists = -1
     Else
       FileExists = 0
     End If

     Set ObjFSO = Nothing
 End Function

 ' Purpose   :   To replace {dot} with {index}{dot} in the file name.
 Function ReplaceFileName(sFileName, iMySheetIndex)

     Dim RepChar, SearchChar

     SearchChar = "."    ' Search for ".".
     RepChar = CStr(iMySheetIndex) & SearchChar
     ReplaceFileName = Replace(sFileName, SearchChar, RepChar)

 End Function

End Class

'Using StringLib class
Dim sText
Dim sReplaced
Set libStr = New StringLib
sReplaced= libStr.ReplaceFileName ("c:\mytests.xls", 5)
MsgBox "Replaced Text: " & sReplaced
Set libStr = Nothing

Excel Automation Using VBScript

Using VBScript, we can automate most of the Excel verification activities. In one project we can export reports to Excel. I have to verify the cell value, font color and Background color. It is difficult task to verify each cell property by any GUI testing tool. All tools are used to identify Excel Grid (Workbook) as Custom Object. I am using VBScript to read the excel contents. Another advantage, you can use the VBScript against different versions of Excel such as 2002, 2003 and 2007. But you need to change the code for Excel 2003 and 2007, if you have done by using GUI objects.

Below I put one Visual Basic script code. It reads the given excel file and put the details of each cell into a log file. Copy all contents from below textbox and save it as MyExcel.vbs and try to run this VBS file. You can run this script by using any GUI Testing tool. Command line call should be cscript MyExcel.vbs sExcelFile iStartRow iStartCol iEndRow iEndCol iSheetIndex

To Know more about this VBA Help, download help from this link Microsoft Office 2003 Editions: Excel VBA Language Reference

If you are unable to run any VBScript, See my earlier post Unable to run VBS or CScript in Windows XP .

VB Script to Read Excel Contents

 
' USAGE: MyExcel.vbs "D:\VB\Complex.xls" iStartRow iStartCol iEndRow iEndCol iSheetIndex
'cscript MyExcel.vbs "D:\VB\Complex.xls" 1 1 30 12 2

'******** Variables Declaration
' Files section
    'XLS File name
gsFile="D:\VB\Complex.xls"  'File with macros
gsLogFile="D:\VB\Results_vbs.log" 

Dim gsExcelFile, giStartRow, giStartCol, giEndRow, giEndCol, giSheetIndex
Dim gsResultsFile                      'Text file name
gsDirSeparator = "\"                         'Directory separator character


If WScript.Arguments.Count = 6 Then
 gsExcelFile = WScript.Arguments.Item(0)
 giStartRow = CInt (WScript.Arguments.Item(1))
 giStartCol = CInt (WScript.Arguments.Item(2))
 giEndRow = CInt (WScript.Arguments.Item (3))
 giEndCol = CInt (WScript.Arguments.Item (4))
 giSheetIndex = CInt (WScript.Arguments.Item (5))
  'To Read the Excel file
  'ReadExcel gsFile, 1, 1, 30, 12, 2
  'WScript.Echo "ReadExcel " , gsExcelFile, giStartRow, giStartCol, giEndRow, giEndCol, giSheetIndex
 ReadExcel gsExcelFile, giStartRow, giStartCol, giEndRow, giEndCol, giSheetIndex

Else
 'WScript.Echo "Usage: MyExcel.vbs sExcelFile iStartRow iStartCol iEndRow iEndCol iSheetIndex"
 'WScript.Quit
 ReadExcel gsFile, 1, 1, 30, 12, 2
End If

'ReadExcel gsFile, 1, 1, 30, 12, 2

'---------------------------------
' Method    :   ReadExcel
' Author    :   T. Palani Selvam
' Purpose   :   Reading Excel contents.
' Parameters:   - Nil
' Returns   :   - Nil
' Caller    :   - Nil
' Calls     :   - Nil

' Revision History:
'
' [No]  da-mon-year Name:    Action:
' [ 1]  07-Nov-2007 Palani   Created first version
'---------------------------------
Sub ReadExcel(sExcelFile, iStartRow, iStartCol, iEndRow, iEndCol, iSheetIndex)

'WScript.Echo "ReadExcel " , sExcelFile, iStartRow, iStartCol, iEndRow, iEndCol, iSheetIndex
 'ReadExcel(sExcelFile As Variant, iStartRow As Integer, iStartCol As Integer, iEndRow As Integer, iEndCol As Integer,iSheetIndex As Integer)

' Purpose: For Excel verification
' To Read the Excel and write into a file
' Each cell content
' Each cell - Foreground color, font name, font style, font size and Background color.


Dim sExcelPath 'As Variant  'Excel file

'********** Excel object declaration **********'
 ' Excel Application object
Dim objExcel 'As Excel.Application
Dim objXLWorkbooks 'As Excel.Workbooks
Dim objXLWorkbook 'As Excel.Workbook

Dim WorkSheetCount 'As Variant  'Work sheets count in a excel
Dim CurrentWorkSheet 'As Excel.Worksheet    ' Current worksheet
Dim objCells 'As Excel.Range
Dim objCurrentCell 'As Variant
Dim objFont 'As Variant

' Result contents
Dim sCellValue 'As Variant
Dim sShowCellValue 'As Variant
Dim sFontName 'As Variant
Dim sFontStyle 'As Variant
Dim iFontSize 'As Variant
Dim iBackColorIndex 'As Variant
Dim iForeColorIndex 'As Variant
Dim iBackColorIndex2 'As Variant
Dim iForeColorIndex2 'As Variant
Dim sResult 'As Variant


' Row and Col integer variables
Dim iUsedRowsCount 'As Integer
Dim iUsedColsCount 'As Integer
Dim iTop, iLeft 'As Integer
Dim iRow 'As Integer     'Row item
Dim iCol 'As Integer     'Col item
Dim iCurRow 'As Integer
Dim iCurCol 'As Integer


If (sExcelFile = "") Then    
    sExcelPath = "D:\VB\Contacts.xls"
Else
    sExcelPath = sExcelFile
End If

if (iSheetIndex = "") Then
  iSheetIndex =1
End If 


FileDeleteAndCreate (gsLogFile)

'XL file check
If (FileExists (sExcelPath) <> 0) Then
  LogWrite ("The Excel file " & Chr(34) & sExcelPath & Chr(34) & " does not exit!")
  'WScript.Echo "The Excel file, " & Chr(34) & sExcelPath & Chr(34) & " does not exit!"
  'WScript.Quit
Else
  LogWrite ("The XL file " & sExcelPath & " exists.")
End If

Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Open sExcelPath, False, True
'WScript.Echo "Reading data from " & sExcelPath
' objExcel.ExecuteExcel4Macro

'On Error GoTo ErrorHandler1
On Error Resume Next


WorkSheetCount = objExcel.Worksheets.Count
'WScript.Echo "We have " & WorkSheetCount & " worksheets."
'Set objXLWorkbook = objExcel.Workbooks(1)
Set objXLWorkbook = objExcel.ActiveWorkbook
'objXLWorkbook.RunAutoMacros

Set CurrentWorkSheet = objExcel.ActiveWorkbook.Worksheets(iSheetIndex) 'iSheetIndex worksheet
'Set CurrentWorkSheet = objExcel.ActiveWorkbook.Worksheets(1) 'First worksheet
' CurrentWorkSheet = objExcel.Worksheets(1) 'First worksheet


iUsedRowsCount = iEndRow 'CurrentWorkSheet.UsedRange.Rows.Count
iUsedColsCount = iEndCol 'CurrentWorkSheet.UsedRange.Columns.Count
iTop = iStartRow 'CurrentWorkSheet.UsedRange.Row
iLeft = iStartCol 'CurrentWorkSheet.UsedRange.Column

' Cells object
CurrentWorkSheet.Cells.Activate

For iRow = iTop To iUsedRowsCount   '(iUsedRowsCount - 1)
    'Read All rows
    For iCol = iLeft To iUsedColsCount  '(iUsedColsCount - 1)
        'Read all Columns
        
        sResult = ""

        Set objCurrentCell = CurrentWorkSheet.Cells(iRow, iCol)
        sCellValue = objCurrentCell.Value
        
        'If ((sCellValue = empty) Or (sCellValue = "empty")) Then
        If ((sCellValue = empty)) Then
            sCellValue = "empty"
         Else
            Set objFont = objCurrentCell.Font
            sFontName = objFont.Name
            
            sFontStyle = objFont.FontStyle
            iFontSize = objFont.Size
            iForeColorIndex = objFont.Color
            iForeColorIndex2 = objFont.ColorIndex
            
            If (sFontName = Empty) Then
                sFontName = "empty"
            End If
            If (sFontStyle = Empty) Then
                sFontStyle = "empty"
            End If
            If (iFontSize = Empty) Then
                iFontSize = "-99999999"
            End If
            If (iForeColorIndex = Empty) Then
                iForeColorIndex = "99999999"
            End If
            If (iForeColorIndex2 = Empty) Then
                iForeColorIndex2 = "99999999"
            End If
            sResult = "Reading Cell {" & CStr(iRow) & "," & CStr(iCol) & "}," & sCellValue & "," & sFontName & "," & CStr(sFontStyle) & "," & CStr(iFontSize) & "," & CStr(iForeColorIndex) & "," & CStr(iForeColorIndex2)
            
            LogWrite (sResult)

        End If
         Set objCurrentCell = Nothing        
         
    Next
    
Next

' This will prevent Excel from prompting us to save the workbook.
objExcel.ActiveWorkbook.Saved = True
Set CurrentWorkSheet = Nothing

'objExcel.Worksbooks.Close
objExcel.Quit

''Set CurrentWorkSheet = Nothing
Set objExcel = Nothing

            
MsgBox "Read COmpleted.", vbOKOnly, "Exec Over"
Exit Sub

ErrorHandler1:
MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description
Err.Clear   ' Clear the error.

End Sub

'---------------------------------
' Method    :   Logwrite
' Author    :   T. Palani Selvam
' Purpose   :   Append the given message into Log file.
' Parameters:   sMsg - String, Contains logging message.
' Returns   :   - Nil
' Caller    :   - Nil
' Calls     :   - Nil

' Revision History:
'
' [No]  da-mon-year Name:    Action:
' [ 1]  07-Nov-2007 Palani   Created first version
'---------------------------------
Sub LogWrite(sMsg)
 Const ForAppending = 8
 'FileName = "D:\VBs\Mysamples\1create.txt"

 Set objFSO = CreateObject("scripting.FileSystemObject")
 Set objTextFile = objFSO.OpenTextFile (gsLogFile, ForAppending, True)

  objTextFile.WriteLine date & " " & time & ": " & sMsg
 objTextFile.Close

 Set objTextFile = Nothing 
 Set objFSO = Nothing 
End Sub

'---------------------------------
' Method    :   FileExists
' Author    :   T. Palani Selvam
' Purpose   :   Checks the given file is avialable or not.
' Parameters:   - Nil
' Returns   :   - Returns As Boolean
' Caller    :   - Nil
' Calls     :   - Nil
'---------------------------------
Function FileExists(strPathName)
'return 0 if a file exists else -1
 Dim ObjFSO
 
 Set ObjFSO = CreateObject("Scripting.FileSystemObject")
 
 if ObjFSO.FileExists(strPathName) = False then
   FileExists = -1
 else
   FileExists = 0
 end If
 
 Set ObjFSO = Nothing
End Function

'---------------------------------
' Method    :   FileDeleteAndCreate
' Author    :   T. Palani Selvam
' Purpose   :   To delete the file if exists..
' Parameters:   - Nil
' Returns   :   - Returns As Boolean
' Caller    :   - Nil
' Calls     :   - Nil
'---------------------------------
Function FileDeleteAndCreate(strFileName)
 ' delete
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 On Error Resume Next
 Set objTextFile = objFSO.GetFile(strFileName)
 objTextFile.Delete
 
 Set objTextFile = objFSO.CreateTextFile(strFileName)
 
 objTextFile.Close
 Set objTextFile = Nothing 
 Set objFSO = Nothing 

End Function

'---------------------------------
' Method    :   Initialize
' Author    :   T. Palani Selvam
' Purpose   :   Initial actions & arrangements will be completed.
' Parameters:   - Nil
' Returns   :   - Nil
' Caller    :   - Nil
' Calls     :   - Nil
'---------------------------------
Sub Initialize()
 'CHECKING INPUT FILES ARE AVAILABLE OR NOT
    gsLogFile = App.Path & "\Results.log"
End Sub

QTP - Descriptive Programming

QuickTestProfessional help refers Descriptive Programming as Programmatic description. Below given few info about Descriptive Programming.

Using Object Repository
When you record an operation on an object, QuickTest adds the appropriate test object to the Object Repository. Once the object exists in the Object Repository, you can add statements in the Expert View to perform additional methods on that object. To add these statements, you usually enter the logical name of each of the objects in the object's hierarchy as the object description, and then add the appropriate method.

Descriptive Programming (Programmatic Description) Usage
Programmatic description can be very useful if you want to perform an operation on an object that is not stored in the Object Repository. You can also use programmatic descriptions in order to perform the same operation on several objects with certain identical properties, or in order to perform an operation on an object whose properties match a description that you determine dynamically during the test run.

There are two types of programmatic descriptions:

1. Static . You list the set of properties and values that describe the object directly in a VBScript statement.
2. Dynamic . You add a collection of properties and values to a Description object, and then enter the Description object name in the statement.

Using the Static type to enter programmatic descriptions directly into your statements may be easier for basic object description needs. However, in most cases, using the Dynamic type provides more power, efficiency, and flexibility.

Useful Links :
Descriptive Programming by QTP Expert Tarun Lalwani

Sample QTP code for Descriptive Programming - Dynamic

Sample QTP code for Descriptive Programming - Static

QTP - Handling Dynamic objects

Most of the QTP (Quick Test Professional) users are using playback methods to develop the scripts. Here I have given a code snippet to handle dynamic objects. You can put the object physical description directly. You can develop the script with Object Repository.

Code: Login for Mercury Flight

Dialog("nativeclass:=#32770","text:=Login").Activate
Dialog("nativeclass:=#32770","text:=Login").WinEdit("nativeclass:=Edit","attached text:=Agent Name:").Set "tester1"
Dialog("nativeclass:=#32770","text:=Login").WinEdit("nativeclass:=Edit","attached text:=Password:").Set "mercury"
Call wait(2)
Dialog("nativeclass:=#32770","text:=Login").WinButton("nativeclass:=Button","text:=OK").Click

Code: Browser certification dialog

If Browser("name:=Certificate Error: Navigation Blocked").Page("title:=Certificate Error: Navigation Blocked").Exist(0) Then
' To DO
End If

VBScript - Passing CmdLine Arguments

I was searching on net, how to pass the command line arguments. It is possible. We can pass the command line arguments in VBScript. If you have worked with command-line tools, you are already familiar with the concept of arguments. Arguments can be divided as Named Arguments and UnNamed Arguments.

Named arguments
Named arguments are arguments that consist of two parts: a name and a value. The name must be prefaced with a forward slash, and a colon must separate the name from the value. The slash prefix and the colon separator are fixed and cannot be changed. See below Example.

RemoteServer.vbs /Host:AppSrv1 /App:Symantec /TimeLimit:2000
Item : Value
Host:AppSrv1
App:Symantec
TimeLimit:2000

UnNamed arguments
The WshUnnamed filtered collection contains the one unnamed argument. The WshUnnamed Count method and Length property return the number of filtered arguments in the WshUnnamed collection. Example is given below.

FormatMask.vbs "D:\VB\FormatMask\Complex.xls" 30 12
Item : Value
0 : D:\VB\FormatMask\Complex.xls
1 : 30
2 : 12

Source: Working with Command-Line Arguments

Code: Example of UnNamed arguments

 
If WScript.Arguments.Count = 3 Then
 ServerName = WScript.Arguments.Item(0)
 EventLog = WScript.Arguments.Item(1)
 EventID = WScript.Arguments.Item(2)
Else
 Wscript.Echo "Usage: GetEvents.vbs ServerName EventLog EventID"
 Wscript.Quit
End If

Code: Named arguments

 
Set colNamedArguments = WScript.Arguments.Named

strServer = colNamedArguments.Item("Server")
strPacketSize = colNamedArguments.Item("PacketSize")
strTimeout = colNamedArguments.Item("Timeout")
Wscript.Echo "Server Name: " & strServer
Wscript.Echo "Packet Size: " & strPacketSize
Wscript.Echo "Timeout (ms): " & strTimeout

QTP - TextBox Length

I was going through EMOS Framework. I think that this framework has been developed in QuickTest Professional 6.5 There I have seen a function to find the text box length. Below I have given that code snippet, which is very simple.

Code:

Public Sub BrowserWebEdit (strWebEdit,strInValue)
If strInValue <> "" Then
'Get Length of strInValue
InLenCount = Len(strInValue) 
'Get Max Length for input
LenCount = Browser(strBrowser).Page(strPage).WebEdit(strWebEdit).GetROProperty ("max length")
If InLenCount > LenCount Then
If LenCount <> -1 Then
'Trim Length of input
Reporter.ReportEvent micWarning, strInValue , InLenCount & ": Length exceeds field input value trimed to: " & LenCount
strInValue = Left(strInValue, LenCount) 
End If  
End If  
Browser(strBrowser).page(strPage).Sync
Browser(strBrowser).Page(strPage).WebEdit(strWebEdit).Set strInValue
End If
End Sub

VBScript - File Read and Write

I have developed few projects using Visual Basic. But I do not have much scripting in Visual Basic Script (VBS). In VB, the file handling functions are different than VBScript. We need to use FileSystemObject for file handling. Below I have given two code snippets to read and write into text files. This code can be used into Quick Test Professional also.

Reading a Text file

 
Const ForReading = 1, ForWriting = 2

FileName = "D:\VBs\Mysamples\1create.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")

If  objFSO.FileExists(FileName) Then

  Set objTextFile = objFSO.OpenTextFile(FileName, ForReading) 

  Do while Not objTextFile.AtEndOfStream
        sLine = objTextFile.ReadLine        
        Wscript.Echo sLine
  loop
 
End If

objTextFile.Close

Set objFile = Nothing 
Set objFSO = Nothing 

Writing to a Text file

 
Const ForAppending = 8
FileName = "D:\VB\Mysamples\1create.txt"

Set objFSO = CreateObject("scripting.FileSystemObject")
Set objTextFile = objFSO.OpenTextFile (FileName, ForAppending, True)

For iIndex=1 to 10
 objTextFile.WriteLine(iIndex)
Next

objTextFile.Close

Set objTextFile = Nothing 
Set objFSO = Nothing 

Convert Number to Word

In my first job, I needed to have a function to verify the number to string conversion. The number should be converted to the word. For example, if user enters 8908 and function returns the output as Eight Thousand Nine Hundred and Eight only. I thought that it is very simple. After starting to write it, I faced few issues. Thats why I created four functions. I have given the code below. The current code converts up to crores. This code snippet can be used in Visual Test or Visual Basic. Few changes needs to be done to use in VB Script.

Code: Returns the word to the given number

 
'---------------------------
' Method : NumberToWord
' Author : T.Palani Selvam
' Purpose :   Returns the word to the given number.
' Parameters: sGivenNum - String, contains to be converted number.
'
' Returns :   Returns String of corresponding number.
' Caller : 
' Calls  : - Nil -
'----------------------------
Function NumberToWord(sGivenNum As String) As String
Dim lBeforeDecimal As Long, lAfterDecimal As Long
Dim iDecimalPos As Integer, iIndex As Integer
Dim sBeforeDecimalWord As String, sAfterDecimalWord As String
Dim sResult As String, sChar As String

 'sResult = Null
    sGivenNum = Trim(Str(Val(sGivenNum)))
    If Val(sGivenNum) = 0 Then
       NumberToWord = "Zero"
       Exit Function
    End If
    sAfterDecimalWord = ""
 sBeforeDecimalWord = ""
    iDecimalPos = InStr(sGivenNum, ".")
    If iDecimalPos = 0 Then
       lBeforeDecimal = Val(sGivenNum)
    Else
       'sGivenNum = Format(sGivenNum, "#####.00")
       lBeforeDecimal = Val(Left(sGivenNum, iDecimalPos - 1))
       lAfterDecimal = Val(Mid(sGivenNum, iDecimalPos + 1))
       If (lAfterDecimal <> 0) Then 
   'sAfterDecimalWord = " Paise " + PrimaryConversion(lAfterDecimal)
   sAfterDecimalWord = " Point" '+ PrimaryConversion(lAfterDecimal)
   For iIndex = 1 To Len(trim(str(lAfterDecimal)))
    sChar = Mid$(trim(str(lAfterDecimal)), iIndex, 1)
    sAfterDecimalWord = sAfterDecimalWord + " " + PrimaryConversion(val(sChar))
   Next iIndex
  End IF
       If (lBeforeDecimal = 0) Then
   NumberToWord = sAfterDecimalWord
   Exit Function
  End IF
    End If

    sBeforeDecimalWord = SplitType(10000000, " Crore ", lBeforeDecimal)
    sBeforeDecimalWord = sBeforeDecimalWord + SplitType(100000, " Lakh ", lBeforeDecimal)
    sBeforeDecimalWord = sBeforeDecimalWord + SplitType(1000, " Thousand ", lBeforeDecimal)
    sBeforeDecimalWord = sBeforeDecimalWord + SplitType(100, " Hundred ", lBeforeDecimal)
    If sBeforeDecimalWord = "" Then
       sBeforeDecimalWord = PrimaryConversion(lBeforeDecimal)
    Else
       sBeforeDecimalWord = sBeforeDecimalWord + "and " + PrimaryConversion(lBeforeDecimal)
    End If
 sResult = sBeforeDecimalWord

    If sAfterDecimalWord = "" Then
       sResult = sBeforeDecimalWord
    Else
       'sResult = sBeforeDecimalWord + " and" + sAfterDecimalWord
    sResult = sBeforeDecimalWord + sAfterDecimalWord
    End If

    NumberToWord = sResult '+ " Only"
End Function

Code: Set the word according to level

 
'-------------------------
' Method : SplitType
' Author : T.Palani Selvam
' Purpose :   Splits a level to next level.
' Parameters: lNumType - Long, contains like 100, 1000
'   sWord - String, contains before conversioned word.
' Returns :   Returns String of corresponding number.
'----------------------------
Function SplitType(lNumType As Long, sWord As String,lBeforeDecimal As long ) As String
'Dim lBeforeDecimal As Long
Dim lNumberType As Long

    SplitType = ""
    lNumberType = lBeforeDecimal \ lNumType
    If lNumberType > 0 Then
       lBeforeDecimal = lBeforeDecimal - lNumberType * lNumType
       SplitType = PrimaryConversion(lNumberType) + sWord
    End If
End Function

Code: Parse a string to the given condition

 
'--------------------------
' Method : GetParsedString
' Author : T.Palani Selvam
' Purpose :   Parse a string to the given condition
' Parameters: sData  - String, contains full string..
'    sSeparate - String, contains separation string
'    iOccur - String, contains position of the Split
' Returns :   Returns String, Null or other values.
'--------------------------
Function GetParsedString(sData As String, sSeparate As String, iOccur As Integer) As String
Dim iPosition As Integer, iIndex As Integer
Dim sTemp As String

 GetParsedString = Null
 sTemp = sData
  
 For iIndex =1 To (iOccur -1) Step 1
  iPosition = Instr(sTemp,sSeparate)
  If (iPosition > 0) Then
    sTemp=Mid$(sTemp,len(sSeparate) + iPosition)   
  Else
   Print(sSeparate + " is not occured")    
   Exit Function
  End If
'  Print "Original Symbol: " + sTemp, sSeparate
 Next iIndex
 iPosition = Instr(sTemp,sSeparate)
 If (iPosition > 0) Then
   sTemp=Left$(sTemp,iPosition - 1)   
 End If
 GetParsedString = sTemp
End Function

Code: Converts primary number to word

 
'----------------------
' Method : PrimaryConversion
' Author : T.Palani Selvam
' Purpose :   It converts primary number to string.
' Parameters: lNumber - Long, contains number
'
' Returns :   Returns String of corresponding number.
'-------------------------
Function PrimaryConversion(lNumber As Long) As String
   PrimaryConversion = ""
   Select Case lNumber
     Case 0
     Case 1 
  PrimaryConversion = "One"
     Case 2 
  PrimaryConversion = "Two"
     Case 3 
  PrimaryConversion = "Three"
     Case 4 
  PrimaryConversion = "Four"
     Case 5 
  PrimaryConversion = "Five"
     Case 6 
  PrimaryConversion = "Six"
     Case 7 
  PrimaryConversion = "Seven"
     Case 8 
  PrimaryConversion = "Eight"
     Case 9 
  PrimaryConversion = "Nine"
     Case 10 
  PrimaryConversion = "Ten"
     Case 11 
  PrimaryConversion = "Eleven"
     Case 12 
  PrimaryConversion = "Twelve"
     Case 13 
  PrimaryConversion = "Thirteen"
     Case 14 
  PrimaryConversion = "Fourteen"
     Case 15 
  PrimaryConversion = "Fifteen"
     Case 16 
  PrimaryConversion = "Sixteen"
     Case 17 
  PrimaryConversion = "Seventeen"
     Case 18 
  PrimaryConversion = "Eighteen"
     Case 19 
  PrimaryConversion = "Nineteen"
     Case 20
  PrimaryConversion = "Twenty"
     Case 30 
  PrimaryConversion = "Thirty"
     Case 40 
  PrimaryConversion = "Forty"
     Case 50 
  PrimaryConversion = "Fifty"
     Case 60 
  PrimaryConversion = "Sixty"
     Case 70 
  PrimaryConversion = "Seventy"
     Case 80 
  PrimaryConversion = "Eighty"
     Case 90 
  PrimaryConversion = "Ninety"
     Case Else  
  PrimaryConversion = PrimaryConversion(lNumber - (lNumber Mod 10)) + " " + PrimaryConversion(lNumber Mod 10)
   End Select
End Function

QTP - Getting INPUT objects

I wrote a qtp (Quicktest Professional) code for listing INPUT element's objects. Descriptive Programming is a feature in QTP. It is used to handle dynamic objects. I will write later about Descriptive Programming. Here below function returns particular type of objects in a web page.

Function:

 
'Calling function to list editboxes
Set ObjEditAll = ListAllWebObjects (Browser("My APP").Page("First Form"),"text")

Function ListAllWebObjects (ObjContainer,sControlType)
'  Getting all type of INPUT objects
Dim MyDescription,objEditBoxes,NoOfChildObjs,Counter,strReport
Dim sTemp, objEdit

 'Initialization
'ListAllWebObjects = Nothing
Set MyDescription = Description.Create() 
MyDescription("html tag").Value = "INPUT" 
MyDescription("type").Value = sControlType 

Set  objEditBoxes = ObjContainer.ChildObjects(MyDescription) 
NoOfChildObjs = objEditBoxes.Count 

strReport = ObjContainer.ToString() & " contains the following child object(s):" 
For Counter=0 to NoOfChildObjs-1 
  strReport = strReport & vbNewLine & objEditBoxes.Item(i).ToString() 
  set objEdit = objEditBoxes(Counter)

  sTemp = objEdit.GetROProperty ("name")
  Reporter.ReportEvent micDone, objEdit.ToString() & " - name property", sTemp
  
  sTemp = objEdit.GetROProperty ("class")
  'sTemp = objEdit.object.ClassName
  Reporter.ReportEvent micDone, objEdit.ToString() & " - class property", sTemp
  
  sTemp = objEdit.GetROProperty ("index")
  Reporter.ReportEvent micDone, objEdit.ToString() & " - index property", sTemp
  
  sTemp = objEdit.GetROProperty ("location")
  Reporter.ReportEvent micDone, objEdit.ToString() & " - location property", sTemp
  
  sTemp = objEdit.GetROProperty ("html id")
  Reporter.ReportEvent micDone, objEdit.ToString() & " - html id property", sTemp
  
  sTemp = objEdit.GetROProperty ("innerhtml")
  Reporter.ReportEvent micDone, objEdit.ToString() & " - innerhtml property", sTemp
  
  sTemp = objEdit.GetROProperty ("outerhtml")
  Reporter.ReportEvent micDone, objEdit.ToString() & " - outerhtml property", sTemp
  
  sTemp = objEdit.GetROProperty ("innertext")
  Reporter.ReportEvent micDone, objEdit.ToString() & " - innertext property", sTemp
  
  sTemp = objEdit.GetROProperty ("outertext")
  Reporter.ReportEvent micDone, objEdit.ToString() & " - outertext property", sTemp
          
Next 

set ListAllWebObjects = objEditBoxes

  Reporter.ReportEvent micDone, ObjContainer.ToString() & " child objects", strReport 
End Function

MS XML Parser by Visual Basic

I love to use XML Parser. It is very easy to do by Visual basic. You can get the equivalent visual test code here - Visual Test - MS XML Parser. I'm thinking to use it in Quick Test Professional (QTP). Below code snippets are simple and easy to use.

Case1: To load any XML content

 
'-----------------------------------------
' Method    :   XMLParserLoadXML
' Author    :   T.Palani Selvam
' Purpose   :   Creates XML Parsing object according to the given XML String.
' Parameters:   sXML - String, contains data in XML Format.
' Returns   :   Returns a Object, which contains XML Parsing object.
' Caller    :   - Nil
' Calls     :   - Nil -
'------------------------------------------
Function XMLParserLoadXML(sXML As String) As Variant
Dim objXML As Variant

    XMLParserLoadXML = Null

    Set objXML = CreateObject("Microsoft.XMLDOM")     'Declare a Object
    objXML.async = False
    objXML.loadXML (sXML)  'Load xmlformat String

    'OleSetProperty(objXML,"preserveWhiteSpace") = False

    If (objXML.parseError <> 0) Then
        LogWrite ("Parsing Error in the File :" + sXMLFile)
        Exit Function
    End If
    
                    'Top Node of given file
    Set XMLParserLoadXML = objXML.documentElement
End Function

Case2: It parsed the given tag in given content and returns the node.

 
'-----------------------------------------
' Method    :   XMLParser
' Author    :   T.Palani Selvam
' Purpose   :   Creates XML Parsing object according to the given XML Format File and Element.
' Parameters:   sXMLFile - String, contains a file name, which is in XML Format.
'               sTag - String, contains element name from which Tag or element based object to be returned.
' Returns   :   Returns a Object, which contains XML Parsing object.
' Caller    :   - Nil
' Calls     :   - Nil -
'-----------------------------------------
Function XMLParser(sXMLFile As String, sTag As String) As Variant
Dim objXML As Variant, objNode As Variant, objTemp As Variant, objRoot As Variant
'Dim varTest As Variant
Dim iIndex As Integer, iTemp As Integer
'Dim objRoot As node

    XMLParser = Null
    sTag = Trim(sTag)
    Set objXML = CreateObject("Microsoft.XMLDOM")     'Declare a Object
    objXML.async = False
    objXML.Load (sXMLFile)  'Load xmlformat file

    If (objXML.parseError <> 0) Then
        LogWrite ("Parsing Error in the File :" + sXMLFile)
        MsgBox ("Parsing Error in the File :" + sXMLFile)
        Exit Function
    End If
    
                    'Top Node of given file
    Set objRoot = objXML.documentElement
    'Print "XML File is : " & sXMLFile
    'Print objRoot.nodeName & " Name of the node.."

    If ((sTag = "") Or (sTag = objRoot.nodeName)) Then
        'XMLParser = CVar(objRoot)
        Set XMLParser = objRoot
        'Set varTest = objRoot
        'XMLParser = objRoot
        Exit Function
    End If

    If objRoot.hasChildNodes <> 0 Then
        objTemp = objRoot.childNodes
        iTemp = objTemp.length

        For iIndex = 0 To iTemp - 1
            objNode = objTemp.Item(iIndex)
            If (UCase(Trim(objNode.nodeName)) = UCase(sTag)) Then
                XMLParser = objNode
                Exit Function
            Else
                Set objNode = Nothing
            End If
        Next iIndex
    End If

    objTemp = objXML.getElementsByTagName(sTag) 'Search whole file with sTag
    iTemp = objTemp.length
    If (iTemp > 0) Then
        objNode = objTemp.Item(0)
        XMLParser = objNode
    End If

End Function