VB通过ADO快速读取EXCEL与TXT文件

介绍了一种高效读取Excel文件的方法,相比传统方式速度快近100倍。此方法适用于30*50格的Excel数据读取,但需注意程序自动生成的Excel文件可能因格式差异导致读取错误,可通过另存为解决。

摘要生成于 C知道 ,由 DeepSeek-R1 满血版支持, 前往体验 >

该方法读取30*50格的EXCEL数据仅需要1秒钟,比使用CELLS属性一个个读取快了将近100倍。但是使用该方法读取程序自动生成的EXCEL文件时会出现如下错误提示:外部表不是预期的格式。

据查是因为程序生成的EXCEL其实同原始的EXCEL文件有所区别(用TXT打开可发现,另属性也有区别)。

解决方法是将EXCEL打开另存为即可。

************************************

以下为新建类代码(该类位于工程组中的Read_Files工程)

若不用工程组,可在代码中相应修改。

*********************************

Option Explicit
' ------------------------------------------------------------
'  Copyright ?001 Mike G --> IvbNET.COM
'  All Rights Reserved, http://www.ivbnet.com
'  EMAIL : webmaster@ivbnet.com
' ------------------------------------------------------------
'  You are free to use this code within your own applications,
'  but you are forbidden from selling or distributing this
'  source code without prior written consent.
' ------------------------------------------------------------


'Read Excel File Using ADO
Public Function Read_Excel _
         (ByVal sFile _
          As String) As ADODB.Recordset

      On Error GoTo fix_err
      Dim rs As ADODB.Recordset
      Set rs = New ADODB.Recordset
      Dim sconn As String

      rs.CursorLocation = adUseClient
      rs.CursorType = adOpenKeyset
      rs.LockType = adLockBatchOptimistic

      sconn = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sFile
      rs.Open "SELECT * FROM [sheet1$]", sconn
      Set Read_Excel = rs
      Set rs = Nothing
      Exit Function
fix_err:
      Debug.Print Err.Description + " " + _
                  Err.Source, vbCritical, "Import"
      Err.Clear
End Function

'**********************************************************************************
'Read Text files
'You can use Extended Properties='text;FMT=Delimited'"
'By adding a third argument we can tell ADO that the file doesn't contain headers.
'The argument named HDR takes YES or NO .
'connOpen "Provider=Microsoft.Jet" _
'         & ".OLEDB.4.0;Data Source=" & App.Path _
'         & ";Extended Properties='text;HDR=NO;" _
'         & "FMT=Delimited'"
'You can use Microsoft Text Driver or Microsoft.Jet
'**********************************************************************************

Public Function Read_Text_File() As ADODB.Recordset

      Dim rs As ADODB.Recordset
      Set rs = New ADODB.Recordset
      Dim conn As ADODB.Connection
      Set conn = New ADODB.Connection
      conn.Open "DRIVER={Microsoft Text Driver (*.txt; *.csv)};" & _
                  "DBQ=" & App.Path & ";", "", ""

      rs.Open "select * from [test#txt]", conn, adOpenStatic, _
                  adLockReadOnly, adCmdText
      Set Read_Text_File = rs
      Set rs = Nothing
      Set conn = Nothing
End Function

 

************************************

以下为窗体代码

*********************************

 

Option Explicit

' ------------------------------------------------------------
'  Copyright ?001 Mike G --> IvbNET.COM
'  All Rights Reserved, http://www.ivbnet.com
'  EMAIL : webmaster@ivbnet.com
' ------------------------------------------------------------
'  You are free to use this code within your own applications,
'  but you are forbidden from selling or distributing this
'  source code without prior written consent.
' ------------------------------------------------------------

Private Sub cmdExit_Click()
  Unload Me
End Sub

Private Sub cmdReadTXT_Click()
      Dim obj As Read_Files.CReadFile
      Set obj = New Read_Files.CReadFile

      Set dgData.DataSource = obj.Read_Text_File
      Set obj = Nothing
End Sub

Private Sub cmdReadXLS_Click()
      Dim obj As Read_Files.CReadFile
      Set obj = New Read_Files.CReadFile

      Set dgData.DataSource = obj.Read_Excel(App.Path & "/" & "test.xls")
      Set obj = Nothing
End Sub

Private Sub Form_Load()

End Sub

 

评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值