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

该方法读取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