Core code
Copy Code code as follows:
Function Readexcel (Myxlsfile, MySheet, My1stcell, Mylastcell, Blnheader)
' Function:readexcel
' version:2.00
' This function reads the data from an Excel sheet without using Ms-office
'
' Arguments:
' Myxlsfile [string] The path and file name of the Excel file
' MySheet [string] The name of the worksheet used (e.g. "Sheet1")
' My1stcell [string] The index of the ' the ' the ' the ' the ' the ' is read (e.g. "A1")
' Mylastcell [string] The index of the ' last cell to be read (e.g. "D100")
' Blnheader [Boolean] True if the sheet is header
'
' Returns:
' The values read from the Excel sheet are returned in a two-dimensional
' Array; The dimension holds the columns, the second dimension holds
' The rows read from the Excel sheet.
'
' Written by Rob van der Woude
' Http://www.robvanderwoude.com
Dim arrdata (), I, J
Dim Objexcel, objRS
Dim Strheader, Strrange
Const adopenforwardonly = 0
Const adOpenKeyset = 1
Const adopendynamic = 2
Const adOpenStatic = 3
' Define header parameter string for Excel object
If Blnheader Then
Strheader = "Hdr=yes;"
Else
Strheader = "Hdr=no;"
End If
' Open ' object for the Excel file
Set Objexcel = CreateObject ("ADODB. Connection ")
' Imex=1 includes cell content of any format; Tip by Thomas Willig
Objexcel.open "Provider=Microsoft.Jet.OLEDB.4.0;Data source=" & _
Myxlsfile & "; Extended properties= "" Excel 8.0;imex=1; & _
Strheader & "" "" "
' Open a Recordset object for the sheet and range
Set objRS = CreateObject ("ADODB. Recordset ")
Strrange = MySheet & "$" & My1stcell & ":" & Mylastcell
Objrs.open "Select * from [" & Strrange & "]", Objexcel, adOpenStatic
' Read the ' data from the Excel sheet
i = 0
Do Until objrs.eof
' Stop reading when a empty row is encountered in the Excel sheet
If IsNull (objrs.fields (0). Value) Or Trim (objrs.fields (0). Value) = "" Then Exit Do
' Add a new row to the output array
ReDim Preserve arrdata (objrs.fields.count-1, i)
' Copy the Excel sheet ' row values to the array ' row '
' IsNull test Credits:adriaan Westra
For j = 0 to Objrs.fields.count-1
If IsNull (Objrs.fields (j). Value) Then
Arrdata (j, i) = ""
Else
Arrdata (j, i) = Trim (Objrs.fields (j). Value)
End If
Next
' Move to the ' next row
Objrs.movenext
' Increment ' The array ' row ' number
i = i + 1
Loop
' Close the file and release the objects
Objrs.close
Objexcel.close
Set objRS = Nothing
Set Objexcel = Nothing
' Return the results
Readexcel = Arrdata
End Function
How to use:
Copy Code code as follows:
Option Explicit
Dim Arrsheet, intcount
' Read and display columns a,b, rows 2..6 of ' Readexceltest.xls '
Arrsheet = Readexcel ("Readexceltest.xls", "Sheet1", "A1", "B6", True)
For intcount = 0 to UBound (Arrsheet, 2)
WScript.Echo Arrsheet (0, intcount) & VbTab & Arrsheet (1, intcount)
Next
WScript.Echo "==============="
' An alternative way to get the same results
Arrsheet = Readexcel ("Readexceltest.xls", "Sheet1", "A2", "B6", False)
For intcount = 0 to UBound (Arrsheet, 2)
WScript.Echo Arrsheet (0, intcount) & VbTab & Arrsheet (1, intcount)
Next
