Function Libraries > Using Microsoft Objects > Using Microsoft Excel Objects

Using Microsoft Excel Objects

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. The examples can be found in the UsingExcel.vbs file located in the <UFT installation folder>\CodeSamplesPlus folder.

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")

'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


'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 Microsoft 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 Microsoft 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
	
	CompareSheets = returnVal
End Function