网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的考试资料:

 

标题 用vbs读取Excel文件的函数代码
内容
    用vbs读取Excel文件的函数代码,不需要安装execl,需要的朋友可以参考下。
    核心代码
    代码如下:
    Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader )
    ' Function : ReadExcel
    ' Version : 2.00
    ' This function reads 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 first cell to be read (e.g. "A1")
    ' myLastCell [string] The index of the last cell to be read (e.g. "D100")
    ' blnHeader [boolean] True if the first row in the sheet is a header
    '
    ' Returns:
    ' The values read from the Excel sheet are returned in a two-dimensional
    ' array; the first 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 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" )
    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 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( objRS.Fields.Count - 1, i )
    ' Copy the Excel sheet's 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
    使用方法:
    代码如下:
    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
随便看

 

在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。

 

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间:2025/5/16 14:20:16