Function FastReadExcel(byval myXlsFile,byval mySheet,byref arrData( ), byref Rscount,byval blnHeader )
Erase arrData
Dim 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 the 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" )
objRS.Open "Select * from [" & mySheet & "$]", objExcel, adOpenStatic
ReDim Preserve arrData( objRS.RecordCount-1, objRS.Fields.Count - 1)
i = 0
Do Until objRS.EOF
' Stop reading when an 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( i, objRS.Fields.Count - 1)
For j = 0 To objRS.Fields.Count - 1
If IsNull( objRS.Fields(j).Value ) Then
arrData( i,j ) = ""
Else
arrData(i,j) = Trim( objRS.Fields(j).Value )
End If
Next
' Move to the next row
objRS.MoveNext
' Increment the array "row" number
i = i + 1
Loop
Rscount = i
' Close the file and release the objects
objRS.Close
objExcel.Close
Set objRS = Nothing
Set objExcel = Nothing
End Function