The following code includes a set of complex and simple functions to serve as examples of the possible uses and applications of Microsoft Excel objects.

Using Microsoft Excel Objects in QTP

The following code includes a set of complex and simple functions to serve as examples of the possible uses and applications of Microsoft Excel objects.

Dim ExcellApp 'As Excel.Application

Dim excelSheet1 'As Excel.worksheet

Dim excelSheet2 'As Excel.worksheet

Set ExcelApp = CreateExcel()

'Create a workbook with two worksheets

ret = RenameWorksheet(ExcelApp, "Book1", "Sheet1", "Example1 Sheet Name")

ret = RenameWorksheet(ExcelApp, "Book1", "Sheet2", "Example2 Sheet Name")

ret = RemoveWorksheet(ExcelApp, "Book1", "Sheet3")

'Save as the workbook under a different name

ret = SaveWorkbook(ExcelApp, "Book1", "D:\Example1.xls")

'Fill the worksheets

Set excelSheet1 = GetSheet(ExcelApp, "Example1 Sheet Name")

Set excelSheet2 = GetSheet(ExcelApp, "Example2 Sheet Name")

For column = 1 to 10

       For row = 1 to 10

              SetCellValue excelSheet1, row, column, row + column

              SetCellValue excelSheet2, row, column, row + column

       Next

Next

'Compare the two worksheets

ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, False)

If ret Then

       MsgBox "The two worksheets are identical"

End If

'Change the values in one sheet

SetCellValue excelSheet1, 1, 1, "Yellow"

SetCellValue excelSheet2, 2, 2, "Hello"

'Compare the worksheets again

ret = CompareSheets(excelSheet1, excelSheet2, 1, 10, 1, 10, True)

If Not ret Then

       MsgBox "The two worksheets are not identical"

End If

'Save the workbook by index identifier

SaveWorkbook ExcelApp, 1, ""

'Close the Microsoft Excel application

CloseExcel ExcelApp

' *************************** Function Library **************************************

Dim ExcelApp 'As Excel.Application

Dim excelSheet 'As Excel.worksheet

Dim excelBook 'As Excel.workbook

Dim fso 'As Scripting.FileSystemObject

' This function returns a new Microsoft Excel object with a default new workbook

Function CreateExcel() 'As Excel.Application

       Dim excelSheet 'As Excel.worksheet

       Set ExcelApp = CreateObject("Excel.Application") 'Create a new Microsoft Excel object

       ExcelApp.Workbooks.Add

       ExcelApp.Visible = True

       Set CreateExcel = ExcelApp

End Function

'This function closes the given Microsoft Excel object

'excelApp - an Excel application object to be closed

Sub CloseExcel(ExcelApp)

       Set excelSheet = ExcelApp.ActiveSheet

       Set excelBook = ExcelApp.ActiveWorkbook

       Set fso = CreateObject("Scripting.FileSystemObject")

       On Error Resume Next

       fso.CreateFolder "C:\Temp"

       fso.DeleteFile "C:\Temp\ExcelExamples.xls"

       excelBook.SaveAs "C:\Temp\ExcelExamples.xls"

       ExcelApp.Quit

       Set ExcelApp = Nothing

       Set fso = Nothing

       Err = 0

       On Error GoTo 0

End Sub

'The SaveWorkbook method saves a workbook according to the workbook identifier.

'The method overwrites the previously saved file in the given path.

'excelApp - a reference to the Microsoft Excel application

'workbookIdentifier - The name or number of the requested workbook

'path - The location to which the workbook should be saved

'Returns "OK" on success and "Bad Workbook Identifier" on failure

Function SaveWorkbook(ExcelApp, workbookIdentifier, path) 'As String

       Dim workbook 'As Excel.workbook

       On Error Resume Next

       Set workbook = ExcelApp.Workbooks(workbookIdentifier)

       On Error GoTo 0

       If Not workbook Is Nothing Then

              If path = "" Or path = workbook.FullName Or path = workbook.Name Then

                     workbook.Save

              Else

                     Set fso = CreateObject("Scripting.FileSystemObject")

                     'If the path has no file extension then add the 'xls' extension

                     If InStr(path, ".") = 0 Then

                            path = path & ".xls"

                     End If

                     On Error Resume Next

                     fso.DeleteFile path

                     Set fso = Nothing

                     Err = 0

                     On Error GoTo 0

                     workbook.SaveAs path

              End If

              SaveWorkbook = "OK"

       Else

              SaveWorkbook = "Bad Workbook Identifier"

       End If

End Function

'The SetCellValue method sets the given 'value' in the cell which is identified by

'its row, column, and parent Microsoft Excel sheet

'excelSheet - The Microsoft Excel sheet that is the parent of the requested cell

'row - the cell's row in the excelSheet

'column - the cell's column in the excelSheet

'value - the value to be set in the cell

Sub SetCellValue(excelSheet, row, column, value)

       On Error Resume Next

       excelSheet.Cells(row, column) = value

       On Error GoTo 0

End Sub

'The GetCellValue returns the cell's value according to its row, column, and sheet

'excelSheet - The Microsoft Excel sheet in which the cell exists

'row - The cell's row

'column - The cell's column

'return 0 if the cell cannot be found

Function GetCellValue(excelSheet, row, column)

       value = 0

       Err = 0

       On Error Resume Next

       tempValue = excelSheet.Cells(row, column)

       If Err = 0 Then

              value = tempValue

              Err = 0

       End If

       On Error GoTo 0

       GetCellValue = value

End Function

'The GetSheet method returns a Microsoft Excel sheet according to the sheet Identifier

'ExcelApp - The Microsoft Excel application which is the parent of the requested sheet

'sheetIdentifier - The name or the number of the requested Microsofr Excel sheet

'return Nothing on failure

Function GetSheet(ExcelApp, sheetIdentifier) 'As Excel.worksheet

       On Error Resume Next

       Set GetSheet = ExcelApp.Worksheets.Item(sheetIdentifier)

       On Error GoTo 0

End Function

'The InsertNewWorksheet method inserts a new worksheet into the active workbook or

'the workbook identified by the workbookIdentifier. The new worksheet will get a default

'name if the sheetName parameter is empty, otherwise the sheet has the sheetName

'as its name.

'Return - The new sheet as an object

'ExcelApp - The Microsoft Excel application object into which the new worksheet should be added

'workbookIdentifier - An optional identifier of the worksheet into which the new worksheet should be added

'sheetName - The optional name of the new worksheet.

Function InsertNewWorksheet(ExcelApp, workbookIdentifier, sheetName) 'As Excel.worksheet

       Dim workbook 'As Excel.workbook

       Dim worksheet 'As Excel.worksheet

       'If the workbookIdentifier is empty, work on the active workbook

       If workbookIdentifier = "" Then

              Set workbook = ExcelApp.ActiveWorkbook

       Else

              On Error Resume Next

              Err = 0

              Set workbook = ExcelApp.Workbooks(workbookIdentifier)

              If Err <> 0 Then

                     Set InsertNewWorksheet = Nothing

                     Err = 0

                     Exit Function

              End If

              On Error GoTo 0

       End If

       sheetCount = workbook.Sheets.Count

       workbook.Sheets.Add , sheetCount

       Set worksheet = workbook.Sheets(sheetCount + 1)

       'If the sheetName is not empty, set the new sheet's name to sheetName

       If sheetName <> "" Then

              worksheet.Name = sheetName

       End If

       Set InsertNewWorksheet = worksheet

End Function

'The RenameWorksheet method renames a worksheet'

'ExcelApp - The Microsoft Excel application that is the worksheet's parent

'workbookIdentifier - The worksheet's parent workbook identifier

'worksheetIdentifier - The worksheet's identifier

'sheetName - The new name for the worksheet

Function RenameWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier, sheetName) 'As String

       Dim workbook 'As Excel.workbook

       Dim worksheet 'As Excel.worksheet

       On Error Resume Next

       Err = 0

       Set workbook = ExcelApp.Workbooks(workbookIdentifier)

       If Err <> 0 Then

              RenameWorksheet = "Bad Workbook Identifier"

              Err = 0

              Exit Function

       End If

       Set worksheet = workbook.Sheets(worksheetIdentifier)

       If Err <> 0 Then

              RenameWorksheet = "Bad Worksheet Identifier"

              Err = 0

              Exit Function

       End If

       worksheet.Name = sheetName

       RenameWorksheet = "OK"

End Function

'The RemoveWorksheet method removes a worksheet from a workbook

'ExcelApp - The Microsoft Excel application that is the worksheet's parent

'workbookIdentifier - The worksheet's parent workbook identifier

'worksheetIdentifier - The worksheet's identifier

Function RemoveWorksheet(ExcelApp, workbookIdentifier, worksheetIdentifier) 'As String

       Dim workbook 'As Excel.workbook

       Dim worksheet 'As Excel.worksheet

       On Error Resume Next

       Err = 0

       Set workbook = ExcelApp.Workbooks(workbookIdentifier)

       If Err <> 0 Then

              RemoveWorksheet = "Bad Workbook Identifier"

              Exit Function

       End If

       Set worksheet = workbook.Sheets(worksheetIdentifier)

       If Err <> 0 Then

              RemoveWorksheet = "Bad Worksheet Identifier"

              Exit Function

       End If

       worksheet.Delete

       RemoveWorksheet = "OK"

End Function

'The CreateNewWorkbook method creates a new workbook in the Microsoft Excel application

'ExcelApp - The Microsoft Excel application to which an new Microsoft Excel workbook will be added

Function CreateNewWorkbook(ExcelApp)

       Set NewWorkbook = ExcelApp.Workbooks.Add()

       Set CreateNewWorkbook = NewWorkbook

End Function

'The OpenWorkbook method opens a previously saved Microsoft Excel workbook and adds it to the Application

'excelApp - The Microsoft Excel application to which the workbook will be added.

'path - The path of the workbook that will be opened

'Returns Nothing on failure

Function OpenWorkbook(ExcelApp, path)

       On Error Resume Next

       Set NewWorkbook = ExcelApp.Workbooks.Open(path)

       Set OpenWorkbook = NewWorkbook

       On Error GoTo 0

End Function

'The ActivateWorkbook method sets one of the workbooks in the application as the active workbook

'ExcelApp - The workbook's parent Microsft Excel application

'workbookIdentifier - The name or the number of the workbook

Sub ActivateWorkbook(ExcelApp, workbookIdentifier)

       On Error Resume Next

       ExcelApp.Workbooks(workbookIdentifier).Activate

       On Error GoTo 0

End Sub

'The CloseWorkbook method closes an open workbook

'ExcelApp - The parent Microsoft Excel application of the workbook

'workbookIdentifier - The name or the number of the workbook

Sub CloseWorkbook(ExcelApp, workbookIdentifier)

       On Error Resume Next

       ExcelApp.Workbooks(workbookIdentifier).Close

       On Error GoTo 0

End Sub

'The CompareSheets method compares two sheets.

'If there is a difference between the two sheets then the value in the second sheet

'will be changed to red and contain the string:

'"Compare conflict - Value was 'Value2', Expected value is 'value2'"

'sheet1, sheet2 - The Microsoft Excel sheets to be compared

'startColumn - The column to start comparing in the two sheets

'numberOfColumns - The number of columns to be compared

'startRow - The row to start comparing in the two sheets

'numberOfRows - The number of rows to be compared

Function CompareSheets(sheet1, sheet2, startColumn, numberOfColumns, startRow, numberOfRows, trimed) 'As Boolean

       Dim returnVal 'As Boolean

       returnVal = True

       'If one of the sheets does not exist, do not continue the process

       If sheet1 Is Nothing Or sheet2 Is Nothing Then

              CompareSheets = False

              Exit Function

       End If

       'Loop through the table and fill values into the two worksheets

       For r = startRow to (startRow + (numberOfRows - 1))

              For c = startColumn to (startColumn + (numberOfColumns - 1))

                     Value1 = sheet1.Cells(r, c)

                     Value2 = sheet2.Cells(r, c)

                     'If 'trimed' equals True then user wants to ignore blank spaces

                     If trimed Then

                            Value1 = Trim(Value1)

                            Value2 = Trim(Value2)

                     End If

                     'if the values of a cell are not equal in the two worksheets

                     'create an indicator that the values are not equal and set the return value

                     'to False

                     If Value1 <> Value2 Then

                            Dim cell 'As Excel.Range

                            sheet2.Cells(r, c) = "Compare conflict - Value was '" & Value2 & "', Expected value is '" & Value1 & "'."

                            Set cell = sheet2.Cells(r, c)

                            cell.Font.Color = vbRed

                            returnVal = False

                     End If

              Next

       Next