VBS读取Excel

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 

 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值