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