VBS 采用单例模式来封装 操作Excel类

Option Explicit

Public oExcel  'Global Var

'''''''''''''''''''''''''''''''''''''''''''''''''''''  
'Description: 采用单例模式来封装的Excel操作类  
'Creator: Eric_1991
'Date : 2014/1/2
'''''''''''''''''''''''''''''''''''''''''''''''''''''

Class ExcelUtil
	Private oExcelObject

	Private Sub Class_Initialize
		Dim boolInit
		boolInit  = False
		Err.Clear
		On Error Resume Next
		
		'boolInit = IsObject(oExcelObject)
		If( IsObject(oExcel) = True ) Then
			If Not oExcel Is Nothing Then 
				'Active status
				boolInit = True
			End If 
		End If 
		
		If boolInit = False Then
			Set oExcel = CreateObject("Excel.Application")
			'oExcel.Visible = True 
			If(Err.Number <> 0) Then
				WSH.Echo Err.Description & " || " &Err.Number
				On Error Goto 0
			End If 
		End  If 
		
		Set oExcelObject = oExcel
				
	End Sub
	
	Private Sub Class_Terminate
		oExcelObject.Quit
		Set oExcelObject = Nothing
		WSH.Echo "close excel app"
	End Sub
	
	'open the workbook by filepath
	Public Default Function OpenWorkbook(strFilepath)
		Err.Clear
		Dim newWorkbook
		On Error Resume Next
	 
		Set newWorkbook = oExcelObject.Workbooks.Open(strFilepath)
		If(Err.Number <> 0) Then
			'WSH.Echo "the filepath is invalid"
			WSH.Echo Err.Description & " || " &Err.Number
			On Error Goto 0
		End If
		Set OpenWorkbook = newWorkbook
		Set newWorkbook = Nothing
	End Function
	
	'change the activate book by workbookname
	Public Function ActivateWorkbook(strWorkbookName)
		Err.Clear
		On Error Resume Next 
		oExcelObject.Workbooks(strWorkbookName).Activate
	End Function 
	
	'todo this action,pls to call ActivateWorkbook Method
	Public Function GetSheet(strWorkbookName, strSheetName)
		Err.Clear
		Dim worksheet
		On Error Resume Next
		'Active the target excel name
		ActivateWorkbook strWorkbookName
		Set worksheet = oExcelObject.Worksheets.Item(strSheetName)
		Set GetSheet = worksheet
		Set worksheet  = nothing
	End Function 
	
	Public Function GetSheetUsedColumnsCount(strFilePath, strFileName, strSheetName)
		Dim workbook, worksheet
		Set workbook = OpenWorkbook(strFilePath)
		Set worksheet = GetSheet(strFileName, strSheetName)
		If Err.Number <> 0 Then 
			WSH.Echo Err.Description & " || " & Err.Number
			On Error Goto 0
		End If 
		GetSheetUsedColumnsCount = worksheet.UsedRange.Columns.Count
		Set worksheet = Nothing
		Set workbook = Nothing
	End Function
	
	Function GetSheetUsedRowsCount(strFilePath, strFilename, strSheetName)
		Dim workbook, worksheet
		Set workbook = OpenWorkbook(strFilePath)
		Set worksheet = GetSheet(strFileName, strSheetName)
		GetSheetUsedRowsCount = worksheet.UsedRange.Rows.Count
		Set worksheet = Nothing
		Set workbook = Nothing
	End Function

	Private Function GetCellvalue(ByRef ExcelSheet, intRow, intColumn)
		On Error Resume Next
		GetCellvalue = ExcelSheet.Cells(intRow, intColumn)
	End Function

	Function GetSheetData2Array(strFilePath, strFileName, strSheetName)
		Dim Columnscount, RowsCount
		Columnscount = GetSheetUsedColumnsCount(strFilePath, strFileName,strSheetName)
		RowsCount = GetSheetUsedRowsCount(strFilePath, strFileName, strSheetName)
		
		Dim workbook, worksheet
		Set workbook = OpenWorkbook(strFilePath)
		
		ActivateWorkbook strFileName
		Set worksheet = GetSheet(strFileName, strSheetName)
		
		ReDim scriptItemArray(RowsCount-2,Columnscount-1)
		Dim Actual
		Dim i,j
		Dim number 

		Actual = 0
		For i=2 To RowsCount
				number = Trim(GetCellvalue(worksheet,i,1))
				If(IsEmpty(number) Or number = "" Or Not (IsNumeric(number))) Then
						'WSH.Echo number 
						Exit For 
				End If
				Actual = Actual + 1
			For j=1 To Columnscount
			    scriptItemArray(i-2,j-1) = Trim(GetCellvalue(worksheet,i,j))
				'WSH.Echo GetCellvalue(worksheet,i,j)
			Next 
		Next
		
		ReDim actualScriptItemArray(Actual-1, Columnscount-1)
	
		For i=0 To Actual-1 
			For j = 0 To Columnscount-1
				actualScriptItemArray(i,j) = scriptItemArray(i,j)
			Next
		Next
		
		Set worksheet = Nothing
		Set workbook =  Nothing
		
		GetSheetData2Array = actualScriptItemArray
		
	End Function 

End Class

Dim fso, obj1,filepath,filename
Set fso = CreateObject("scripting.filesystemobject")
Set obj1 = New ExcelUtil
filepath = "D:\dd1.xlsx"
filename = fso.GetFileName(filepath)

Dim arrDate
arrDate = obj1.GetSheetData2Array(filepath, filename, "script")

Dim oneDimension
Dim twoDimension 

oneDimension = UBound(arrDate,1)
twoDimension = UBound(arrDate,2)
Dim i,j
For i = 0 To UBound(arrDate,1)
	For j = 0 To UBound(arrDate,2)
		WSH.Echo arrDate(i,j)
	Next 
	WSH.Echo "==============================="
Next

Set obj1 = Nothing
Set fso = Nothing