'輸入:
' sFileName:Excel 檔
' sSheetName: 表格名稱
' lookupstr:尋找的資料
'返回:
' 包含Excel 資料的陣列
Function ReadFile(sFileName,sSheetName)
Dim oExcelapp
Dim oExcel
Dim oSheet
' Dim oRange
' Dim arrRange
On Error resume next
'創建EXCEL 應用程式物件
Set oExcelapp=CreateObject("Excel.Application")
oExcelapp.Visible = True
If err.number <>0 Then
msgbox "未能初始化Excel"&vbCrLf&_
"請確保Excel已安裝", vbcritical
Exit function
End If
On error goto 0
On Error resume next
'打開Excel檔
set oExcel=oExcelapp.Workbooks.Open(sFileName)
oExcel.Worksheets(sSheetName).Activate
If err.number <>0 Then
msgbox "未能載入Excel檔"&vbCrLf&_
"請確保Excel檔路徑正確或格式正確", vbcritical
Exit function
End If
On error goto 0
'獲取表的使用範圍 www.it165.net
'Set oSheet=oExcel.Worksheets(sSheetName).UsedRange
Set oSheet=oExcel.Worksheets(sSheetName).UsedRange
Set oRange=oSheet.Range("A1:Z200")
arrRange=oRange.value
oExcelapp.Workbooks.Close
Window("text:=Microsoft Excel").Close
ReadFile=arrRange

 

'無用語句
'Set oSheet=oExcel.Worksheets(sSheetName)
'For i=1 to 100
'If oSheet.cell(i,1).value= lookupstr Then
'ReadFile=oSheet.cell(i,2).value
'Exit function
'End If
'Next
'關閉活頁簿
'oExcelapp.Workbooks.Item(1).Close
'退出Excel
'oExcelapp.Quit
'Set oExcelapp=nothing
End Function
'指定參數取用
'輸入:
' ObjName:測試物件名稱
' 返回:測試物件名稱對應的字串
Function GetTestObject(objName)
Dim objArray
objArray=ReadFile("D:\new.xls","sheet1")
For i=1 to UBound(objArray,1)
If objArray(i,1)=objName Then
GetTestObject=objArray(i,2)
Exit function
End If
Next
End Function

 

創作者介紹
創作者 shadow 的頭像
shadow

資訊園

shadow 發表在 痞客邦 留言(0) 人氣()