怎样用ADO连Excel文件，能否给个列子？（在线等）

Question

如题，用DAO也可以。以下是我自己写的，能不能帮我指处一下问题的地方，谢谢各位了！
Private Sub form_load()
 Dim dbname as String
 Dim cnn As New ADODB.connection
 Dim rst As New ADODB.Recordset
   
   set dbname=d:\sonic.xls
cnn.ConnectionString= "Provider=MSDASQL.1;uid=administrator;pwd=;Data Source=Excel Files "
   cnn.CursorLocation = adUseClient
   cnn.Open
   Set rst = cnn.Opendatabase(dbname)
   Set MSChart1.DataSource = rst
    Me.Hide
 Form2.Show
End Sub

Answer 1

伤心啊，竟然没人回答，还好我自己知道了Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\数据分析\123.xls;Extended Properties=excel 8.0;Persist Security Info=False

Answer 2

Private Sub cmdReadXLS_Click()
      Set dgData.DataSource = Read_Excel(App.Path & "\" & "test.xls")
      Set obj = Nothing
End SubPublic 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

Answer 3

'
'创建一个连接(连接到其它数据库类型)
'函数名:CreateOtherConn
'参数:  DbConnection ADODB连接,FilePath 数据库路径,UserName 登录用户名,PassWord 登录密码,DbType SmDbType枚举数据库类型
'返回值:TRUE 连接成功.FALSE 连接失败.
'例:
'CreateOtherConn Cnn, "E:\CjhLx\dbf", , , FoxPro
'StrSql = "select * from [employee.dbf]"
'Set Rs = RsOpen(Cnn, StrSql)
'Set DataGrid1.DataSource = RsPublic Function CreateOtherConn(ByRef DbConnection As ADODB.Connection, _
                               FilePath As String, _
                               Optional UserName As String = "admin", _
                               Optional PassWord As String = "", _
                               Optional DbType As SmDbType = Access) As Boolean
        Dim ConnStr As String
        Dim DriveName(5) As String
        Dim tDbType(5) As String
        Dim UserPwd(5) As String
        
        '/驱动程序
        DriveName(1) = "{Microsoft Access Driver (*.mdb)}"
        DriveName(2) = "{Microsoft Excel Driver (*.xls)}"
        DriveName(3) = "{Microsoft Text Driver (*.txt; *.csv)}"
        DriveName(4) = "{Microsoft Visual FoxPro Driver};SourceType=DBF"
        DriveName(5) = "{Microsoft dBase Driver (*.dbf)}"
        '/类型
        tDbType(1) = "MDB"
        tDbType(2) = "XLS"
        tDbType(3) = "TXT"
        tDbType(4) = "FDB"
        tDbType(5) = "DDB"
        '/用户名和密码.
        UserPwd(1) = "Uid=" & UserName & ";Pwd=" & PassWord & ";"
        UserPwd(2) = "Uid=" & UserName & ";Pwd=" & PassWord & ";"
        UserPwd(3) = ""
        UserPwd(4) = "Uid=" & UserName & ";Pwd=" & PassWord & ";"
        UserPwd(5) = "Uid=" & UserName & ";Pwd=" & PassWord & ";"
        
        On Error Resume Next
        
        If DbConnection.State = adStateOpen And Not IsEmpty(adStateOpen) Then
           DbConnection.Close
        End If
        ConnStr = "Provider=MSDASQL.1;Persist Security Info=False;DRIVER=" & DriveName(DbType) & ";" & UserPwd(DbType) & "DBQ=" & FilePath
        DbConnection.ConnectionString = ConnStr
        DbConnection.Open
        DoEvents
          
        If Err.Number = 0 Then
           DbStyle = tDbType(DbType)
           CreateOtherConn = True
        Else
           Err.Clear
           DbStyle = ""
           CreateOtherConn = False
        End If
  End Function

Answer 4

多看看MS的KB
http://support.microsoft.com/default.aspx?scid=kb;EN-US;278973

Answer 5

三、 使用VB实现Excel自动获取外部数据
(1) 进行手动获取外部数据(1)步骤前，单击“工具”菜单中的“宏”，选择“录制新宏”，在“宏名”的编辑框中键入宏名dbftoxls,按“确定”键；
(2) 完成手动获取外部数据(1)-(8)步骤；
(3) 单击“工具”菜单中的“宏”，选择“停止录制”。这样就将获取外部数据的过程记录为宏。
(4) 编辑dbftoxls宏，加以修改，使它作为Visual Basic模块表中的一个子程序，并设置调用参数。
提供的程序如下：`设置初值
Const apppath = "c:\my documents\palmxls\"
Const modulefile = apppath + "module.xls"
Const staticspre = "TTT"
Const dbfpre = "ATV00"`调用dbftoxls的模块
Private Sub Cmdgeneratetable_Click()
Dim staticsfile As String
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim idyes As Integer
Dim dbfstring As StringOn Error GoTo errhandler1
idyes = 6
s1 = txtyear.Text
s1 = Mid(s1, 3, 2)
s2 = txtmonth.Text
If Len(s2) = 1 Then
s2 = "0" + s2
End If
staticsfile = apppath + staticspre + s1 + s2 + ".xls"
If FileLen(staticsfile) > 0 Then
choice = MsgBox("该年月报表已存在，是否重新生成？", vbYesNo + vbExclamation + vbDefaultButton1, "")
If choice = idyes Then
Workbooks.Open FileName:=staticsfile
For i = 0 To companynum - 1
For j = 0 To tablenum - 1
dbfstring = dbfpre + Trim(Str$(j + 1)) + s2
sqlstring = sqlstringfunc(dbfstring, fieldlist(), tablefieldnum(j))
Call dbftoxls(s(i, j), sqlstring)
Next j
Next i
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End If
Exit Suberrhandler1:
Select Case Err
Case 53
Workbooks.Open FileName:=modulefile
s3 = s1 + "年" + s2 + "月"
Sheets("资产负债表").Range("e4").FormulaR1C1 = "注释：" + s3
ActiveWorkbook.SaveAs FileName:=staticsfile, FileFormat :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= False, CreateBackup:=False
For i = 0 To companynum - 1
For j = 0 To tablenum - 1
dbfstring = dbfpre + Trim(Str$(j + 1)) + s2
sqlstring = sqlstringfunc(dbfstring, fieldlist(), tablefieldnum(j))
Call dbftoxls(s(i, j), sqlstring)
Next j
Next i
ActiveWorkbook.Save
ActiveWorkbook.Close
End Select
End Sub`dbftoxls子程序
Sub dbftoxls(activesheetname, sqlstring)
Sheets(activesheetname).Activate
Cells.Select
Selection.Clear
Range("a1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array("ODBC;CollatingSequence=ASCII;DBQ=C:\T\palm1;DefaultDir=C:\T\palm1;Deleted=1;Driver={MicrosoftdBase Driver (*.dbf)};DriverId=533;FIL"), Array("=dBase III;ImplicitCommitSync=Yes;MaxBufferSize=512;MaxScanRows=8;PageTimeout=600;SafeTransactions=0;Statistics=0;Threads=3;Use" ), Array("rCommitSync=Yes;")), Destination:=Range("A1"))
.Sql = Array( sqlstring)
.FieldNames = True
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = True
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = True
.SaveData = True
End With
End Sub