relevantcodes发布了一个名为ExcelUtil的Excel库，封装了Excel的常用操作，方便于QTP的Excel数据读写：
http://relevantcodes.com/excelutil-class-library-excel-utility-methods/
引用了这个ExcelUtil库之后，可以像如下代码使用：
'Example 1 ExcelUtil.SetFile "C:\Student.xls", "Sheet1" 'Example 2: Reading value directly from a file sCellValue = ExcelUtil.SetFile("C:\Student.xls", "Sheet1").GetCellValue(1, 1) 'Example 3: Reading values from 2 different files - Approach 1 ExcelUtil.SetFile "C:\Student.xls", "Sheet1" var1 = ExcelUtil.GetCellValue(1, 1) ExcelUtil.SetFile "C:\Teacher.xls", "Sheet1" var2 = ExcelUtil.GetCellValue(1, 1) 'Example 4: Reading values from 2 different files - Approach 2 var1 = ExcelUtil.SetFile("C:\Student.xls", "Sheet1").GetCellValue(1, 1) var2 = ExcelUtil.SetFile("C:\Teacher.xls", "Sheet1").GetCellValue(1, 1)
库函数文件的代码比较多，如下所示：
''' <file>RelevantCodes.ExcelUtil.cls.vbs</file>
''' <author>Anshoo Arora</author>
''' <company>Relevant Codes</company>
''' <copyright>Relevant Codes</copyright>
''' <version>1.0</version>
Option Explicit
''' <summary>
''' Global ExcelApplication (Excel.Application) object reference
''' Note: The global instance is destroyed through ExcelUtil.Destroy()
''' </summary>
''' <remarks></remarks>
Public ExcelApplication
'Root Namespace RelevantCodes
''' <summary>
''' Private Class [RelevantCodes.ExcelUtil]
''' </summary>
''' <remarks></remarks>
Class [RelevantCodes.ExcelUtil]
'Private Variables
''' <summary>
''' Range object created in FindCellContainingValue and passed to FindNextCell
''' </summary>
''' <remarks></remarks>
Private rngFound
''' <summary>
''' Region Excel.Application instance created in Class_Initialize
''' </summary>
''' <remarks></remarks>
Private xlsApp
''' <summary>
''' Region Excel WorkBook instance created in SetFile
''' </summary>
''' <remarks></remarks>
''' <seealso>SetFile()</seealso>
Private xlsBook
''' <summary>
''' Region Excel WorkSheet instance created in SetFile
''' </summary>
''' <remarks></remarks>
Private xlsSheet
''' <summary>
''' WorkBook path
''' </summary>
''' <remarks></remarks>
Private sWorkBook
''' <summary>
''' WorkSheet name
''' </summary>
''' <remarks></remarks>
Private sWorkSheet
'Public Properties
''' <summary>
''' Sets the region instances for Excel WorkBook and WorkSheet. These instances for the
''' Excel source are created only once and used by other methods.
''' NOTE: For any method to execute, SetFile must be executed first to set the WorkBook and WorkSheet.
''' </summary>
''' <param name="WorkBook" type="string">Path to the Excel WorkBook</param>
''' <param name="WorkSheet" type="string">Name or Item Number of the WorkSheet</param>
''' <returns>XLSUtil</returns>
Public Property Get SetFile(ByVal WorkBook, ByVal WorkSheet)
Dim fso
Set SetFile = Me
If xlsApp Is Nothing Then Exit Property
'c#: this.sWorkBook = WorkBook;
'vb: Me.sWorkBook = WorkBook
If sWorkBook = "" Then sWorkBook = WorkBook
'c#: this.sWorkSheet = WorkSheet;
'vb: Me.sWorkSheet = WorkSheet
If sWorkSheet = "" Then sWorkSheet = WorkSheet
If sWorkBook <> WorkBook Then
xlsBook.Close
sWorkBook = WorkBook
End If
If sWorkSheet <> WorkSheet Then
sWorkSheet = WorkSheet
End If
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(WorkBook) Then
MsgBox "Unable to find the Excel WorkBook with the given path: " & _
WorkBook, vbOKOnly, "ExcelFile.SetFile->'File Not Found' Exception!"
Set fso = Nothing
Exit Property
End If
Set xlsBook = xlsApp.WorkBooks.Open(WorkBook)
If Err.Number <> 0 Then
MsgBox "Unable to load the WorkBook: " & WorkBook, vbOKOnly, _
"SetFile->'xlsApp.WorkBooks.Open(WorkBook)' Exception!"
Err.Clear
Exit Property
End If
If Not IsNumeric(WorkSheet) Then
Set xlsSheet = xlsBook.WorkSheets(WorkSheet)
Else
Set xlsSheet = xlsBook.WorkSheets.Item(WorkSheet)
End If
If Err.Number <> 0 Then
MsgBox "Unable to bind to the WorkSheet: " & WorkSheet, vbOKOnly, _
"ExcelUtil.SetFile->'xlsApp.WorkBooks.WorkSheets(Sheet)' Exception!"
Err.Clear
Exit Property
End If
On Error Goto 0
End Property
''' <summary>
''' Returns a Scripting.Dictionary object with heading & row pair.
''' </summary>
''' <param name="iRow" type="integer">Data Row</param>
''' <param name="iHeadingRow" type="integer">Heading Row</param>
''' <returns>Scripting.Dictionary</returns>
Public Property Get BuildRowHeadingDictionary(ByVal iRow, ByVal iHeadingRow)
Dim oRange, arrRange, iColumns, dic, iCol
Set oRange = GetWorkSheetRange
arrRange = oRange.Value
iColumns = UBound(oRange.Value, 2)
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
For iCol = LBound(arrRange, 2) To UBound(arrRange, 2)
If Not dic.Exists(arrRange(1, iCol)) Then
dic.Add CStr(arrRange(iHeadingRow, iCol)), CStr(arrRange(iRow, iCol))
End If
Next
Set BuildRowHeadingDictionary = dic
End Property
''' <summary>
''' Reads the value of a cell in an Excel WorkSheet
''' </summary>
''' <param name="iRow" type="integer">Row number</param>
''' <param name="vColumn" type="variant">Column letter or number</param>
''' <returns>String</returns>
Public Property Get GetCellValue(ByVal iRow, ByVal vColumn)
GetCellValue = xlsSheet.Cells(iRow, vColumn).Value
End Property
''' <summary>
''' Returns the complete WorkSheet Range object
''' </summary>
''' <returns>Range</returns>
Public Property Get GetWorkSheetRange()
Set GetWorkSheetRange = xlsSheet.UsedRange
End Property
''' <summary>
''' Returns a 2D array from the WorkSheet
''' </summary>
''' <returns>Array</returns>
Public Property Get Get2DArrayFromSheet()
Get2DArrayFromSheet = GetWorkSheetRange.Value
End Property
''' <summary>
''' Returns a Range object if the supplied argument is found in the WorkSheet
''' </summary>
''' <param name="arg" type="variant">Value being searched for</param>
''' <returns>Range</returns>
Public Property Get FindCellContainingValue(ByVal arg)
Dim cell
Set cell = xlsSheet.UsedRange.Find(arg)
'c#: this.rngFound = cell;
'vb: Me.rngFound = cell
Set rngFound = cell
Set FindCellContainingValue = cell
End Property
''' <summary>
''' Finds the next cell from the supplied argument in FindCellContainingValue
''' </summary>
''' <returns>Range</returns>
''' <seealso>FindCellContainingValue</seealso>
Public Property Get FindNextCell()
Dim cell
Set cell = xlsSheet.UsedRange.FindNext(rngFound)
Set rngFound = cell
Set FindNextCell = cell
End Property
''' <summary>
''' Finds the number of used rows in the Excel WorkSheet
''' </summary>
''' <returns>Integer</returns>
Public Property Get GetUsedRowCount()
GetUsedRowCount = xlsSheet.UsedRange.Rows.Count
End Property
''' <summary>
''' Finds the number of used columns in the Excel WorkSheet
''' </summary>
''' <returns>Integer</returns>
Public Property Get GetUsedColumnCount()
GetUsedColumnCount = xlsSheet.UsedRange.Columns.Count
End Property
''' <summary>
''' Finds the number of used rows in an Excel WorkSheet by column
''' </summary>
''' <param name="vColumn" type="variant">Column letter or number</param>
''' <returns>Integer</returns>
Public Property Get GetUsedRowCountByColumn(ByVal vColumn)
Const xlDown = -4121
GetUsedRowCountByColumn = xlsSheet.Cells(1, vColumn).End(xlDown).Row
End Property
''' <summary>
''' Finds the number of used columns in an Excel WorkSheet by row
''' </summary>
''' <param name="iRow" type="integer">Row number</param>
''' <returns>Integer</returns>
Public Property Get GetUsedColumnCountByRow(ByVal iRow)
Const xlToRight = -4161
GetUsedColumnCountByRow = xlsSheet.Cells(iRow, 1).End(xlToRight).Column
End Property
'Public Methods
''' <summary>
''' Inputs a value to an Excel cell
''' </summary>
''' <param name="iRow" type="integer">Value input</param>
''' <param name="vColumn" type="variant">Row number</param>
''' <param name="TheValue" type="variant">Column letter or number</param>
''' <remarks></remarks>
Public Sub WriteCellValue(ByVal TheValue, ByVal iRow, ByVal vColumn)
If TheValue = "" Then Exit Sub
xlsSheet.Cells(iRow, vColumn).Value = TheValue
xlsBook.Save
End Sub
''' <summary>
''' Inserts an image in a Excel cell
''' </summary>
''' <param name="iRow" type="integer">Row number</param>
''' <param name="vColumn" type="variant">Column letter or number</param>
''' <param name="ImagePath" type="string">Path to the image file</param>
''' <remarks></remarks>
Public Sub InsertImageInCell(ByVal iRow, ByVal vColumn, ByVal ImagePath)
Dim fso, pic
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(ImagePath) Then
MsgBox "Unable to find the Image with the given path: " & _
ImagePath & ".", vbOKOnly, "ExcelUtil.InsertImageInCell->'File Not Found' Exception!"
Set fso = Nothing
Exit Sub
End If
xlsSheet.Cells(iRow, vColumn).Select
With xlsSheet
Set pic = .Pictures.Insert(ImagePath)
With .Cells(iRow, vColumn)
pic.top = .Top
pic.left = .Left
pic.ShapeRange.height = .RowHeight * 1
pic.ShapeRange.width = .ColumnWidth * .ColumnWidth
End With
End With
xlsBook.Save
End Sub
''' <summary>
''' Changes the background color of a cell
''' </summary>
''' <param name="ColorCode" type="variant">Value of the custom color</param>
''' <param name="iRow" type="integer">Row number</param>
''' <param name="vColumn" type="variant">Column letter or number</param>
''' <remarks></remarks>
Public Sub ChangeCellBGColor(ByVal ColorCode, ByVal iRow, ByVal vColumn)
xlsSheet.Cells(iRow, vColumn).Interior.ColorIndex = ColorCode
xlsBook.Save
End Sub
''' <summary>
''' Changes the font color of a cell
''' </summary>
''' <param name="ColorCode" type="variant">Value of the custom color</param>
''' <param name="iRow" type="integer">Row number</param>
''' <param name="vColumn" type="variant">Column letter or number</param>
''' <remarks></remarks>
Public Sub ChangeCellFontColor(ByVal ColorCode, ByVal iRow, ByVal vColumn)
xlsSheet.Cells(iRow, vColumn).Font.ColorIndex = ColorCode
xlsBook.Save
End Sub
''' <summary>
''' Changes the font size
''' </summary>
''' <param name="iFontSize" type="integer">New font size</param>
''' <param name="iRow" type="integer">Row number</param>
''' <param name="vColumn" type="variant">Column letter or number</param>
''' <remarks></remarks>
Public Sub ChangeFontSize(ByVal iFontSize, ByVal iRow, ByVal vColumn)
xlsSheet.Cells(iRow, vColumn).Font.Size = iFontSize
xlsBook.Save
End Sub
''' <summary>
''' Draws a border to the left, right, top, or bottom of a given range
''' </summary>
''' <param name="Range" type="range">Excel Range</param>
''' <param name="Direction" type="variant">Direction: left, right, top, bottom</param>
''' <remarks></remarks>
Public Sub DrawBorder(ByVal Range, ByVal Direction)
If IsNumeric(Direction) Then Direction = CStr(Direction)
Direction = LCase(Direction)
With xlsSheet.Range(Range)
Select Case Direction
Case "1", "left"
.Borders(1).LineStyle = 1
Case "2", "right"
.Borders(2).LineStyle = 1
Case "3", "top"
.Borders(3).LineStyle = 1
Case "4", "bottom"
.Borders(4).LineStyle = 1
Case "5", "all"
Dim ix
For ix = 1 To 4
.Borders(ix).LineStyle = 1
Next
Case Else
MsgBox "Invalid Direction: ' " & Direction & " '" & vbNewLine & _
"Please provide the correct Direction to draw the border." & _
Direction, vbOKOnly, "DrawBorder->'Invalid Direction' Exception!"
Exit Sub
End Select
End With
xlsBook.Save
End Sub
''' <summary>
''' Merges the cells in a range
''' </summary>
''' <param name="Range" type="range">Excel Range</param>
''' <remarks></remarks>
Public Sub MergeCells(ByVal Range)
xlsApp.DisplayAlerts = False
xlsSheet.Range(Range).MergeCells = True
xlsApp.DisplayAlerts = True
xlsBook.Save
End Sub
''' <summary>
''' Removes the merge feature from cells of a given range
''' </summary>
''' <param name="Range" type="range">Excel Range</param>
''' <remarks></remarks>
Public Sub UnmergeCells(ByVal Range)
xlsApp.DisplayAlerts = False
xlsSheet.Range(Range).MergeCells = False
xlsApp.DisplayAlerts = True
xlsBook.Save
End Sub
''' <summary>
''' Inserts a hidden or visible comment in a cell
''' </summary>
''' <param name="CommentText" type="variant">Comment text</param>
''' <param name="iRow" type="integer">Row number</param>
''' <param name="vColumn" type="variant">Column letter or number</param>
''' <param name="bMakeVisible" type="bool">Make the comment visible or hidden</param>
''' <remarks></remarks>
Public Sub InsertComment(ByVal CommentText, ByVal bMakeVisible, ByVal iRow, ByVal vColumn)
With xlsSheet.Cells(iRow, vColumn)
If Not .Comment Is Nothing Then .Comment.Delete
.AddComment CommentText
.Comment.Visible = bMakeVisible
End With
xlsBook.Save
End Sub
''' <summary>
''' Creates and saves a new WorkBook for a given path
''' </summary>
''' <param name="WorkBookPath" type="string">Path of the Excel file</param>
''' <remarks></remarks>
Public Sub CreateNewWorkBook(ByVal WorkBookPath, ByVal bReplaceOldFile)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(WorkBookPath) Then
If bReplaceOldFile Then
fso.DeleteFile(WorkBookPath)
Else
Exit Sub
End If
End If
Set xlsBook = xlsApp.Workbooks.Add
xlsBook.SaveAs WorkBookPath
End Sub
''' <summary>
''' Adds a WorkSheets to a given WorkBook
''' </summary>
''' <param name="WorkBook" type="string">Path to the Excel file</param>
''' <param name="WorkSheetName" type="string">New WorkSheet name</param>
''' <remarks></remarks>
Public Sub AddWorkSheet(ByVal WorkBook, ByVal WorkSheetName)
Dim fso, xlsBook, xlsSheet
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(WorkBook) Then
MsgBox "Unable to find the Excel WorkBook with the given path: " & _
WorkBook, vbOKOnly, "NewWorkSheet->'File Not Found' Exception!"
Set fso = Nothing
Exit Sub
End If
Set xlsBook = xlsApp.Workbooks.Open(WorkBook)
For Each xlsSheet in xlsBook.WorkSheets
If LCase(xlsSheet.Name) = LCase(WorkSheetName) Then Exit Sub
Next
Set xlsSheet = xlsBook.Worksheets.Add
xlsSheet.Name = WorkSheetName
xlsBook.Save
End Sub
''' <summary>
''' Closes the WorkBook opened in SetFile
''' </summary>
''' <remarks></remarks>
Public Sub CloseWorkBook()
On Error Resume Next
xlsBook.Close
If Err.Number <> 0 Then Err.Clear
On Error Goto 0
End Sub
''' <summary>
''' Releases the global (ExcelApplication) Excel instance
''' </summary>
''' <remarks></remarks>
Public Sub Destroy()
ExcelApplication.Quit
Set ExcelApplication = Nothing
End Sub
'Private Methods
''' <summary>
''' Class Initialization procedure. Creates Excel Singleton.
''' </summary>
''' <remarks></remarks>
Private Sub Class_Initialize()
Dim bCreated : bCreated = False
Set xlsApp = Nothing
If IsObject(ExcelApplication) Then
If Not ExcelApplication Is Nothing Then
If TypeName(ExcelApplication) = "Application" Then
bCreated = True
End If
End If
End If
If Not bCreated Then
On Error Resume Next
Set ExcelApplication = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Err.Clear
Set ExcelApplication = CreateObject("Excel.Application")
End If
If Err.Number <> 0 Then
MsgBox "Please install Excel before using ExcelUtil", vbOKOnly, "Excel.Application Exception!"
Err.Clear
Exit Sub
End If
On Error Goto 0
End If
Set xlsApp = ExcelApplication
End Sub
''' <summary>
''' Class Termination procedure
''' </summary>
''' <remarks></remarks>
Private Sub Class_Terminate()
Set xlsApp = Nothing
If IsObject(xlsBook) Then
If Not xlsBook Is Nothing Then
Set xlsBook = Nothing
End If
End If
If IsObject(xlsSheet) Then
If Not xlsSheet Is Nothing Then
Set xlsSheet = Nothing
End If
End If
End Sub
End Class
''' <summary>
''' ExcelUtil = RelevantCodes.ExcelUtil Class Instance
''' </summary>
Dim ExcelUtil : Set ExcelUtil = New [RelevantCodes.ExcelUtil]