怎样用ADO连Excel文件，能否给个列子？（在线等）
如题，用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
问题点数：20、回复次数：6Top
1 楼yujiang930（散步的鱼）回复于 2004-03-16 22:26:20 得分 0
伤心啊，竟然没人回答，还好我自己知道了
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\数据分析\123.xls;Extended Properties=excel 8.0;Persist Security Info=FalseTop
2 楼online（龙卷风V4.0--决战江湖(MS MVP-VB)）回复于 2004-03-16 22:39:41 得分 5
Private Sub cmdReadXLS_Click()
Set dgData.DataSource = Read_Excel(App.Path & "\" & "test.xls")
Set obj = Nothing
End Sub
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
Top
3 楼MSTOP（陈建华）回复于 2004-03-16 22:56:03 得分 5
'
'创建一个连接(连接到其它数据库类型)
'函数名: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 = Rs
Public 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
Top
4 楼lihonggen0（李洪根，MS MVP，标准答案来了）回复于 2004-03-17 09:24:55 得分 5
多看看MS的KB
http://support.microsoft.com/default.aspx?scid=kb;EN-US;278973Top
5 楼chenkangli（编程浪子）回复于 2004-03-17 09:34:01 得分 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 String
On 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 Sub
errhandler1:
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
Top
6 楼demo001（给分是我最大的快乐）回复于 2004-03-17 13:16:03 得分 0
markTop
相关问题
关键词
得分解答快速导航
相关链接
广告也精彩
反馈
