VB读取ACCESS数据库

Private Sub Command1_Click()
Dim dbs As Database '定义为数据库类型
Dim rst As Recordset '定义为记录类型
Dim theday As Date '定义为日期类型
Dim i As Integer
Dim Bcell, Ecell, SQLString As String

On Error GoTo aa:
Set ExcelReport = New Excel.Application
ExcelReport.Workbooks.Open FileName:=App.Path + "\APP\脱硫系统运行日志.xls"
ExcelReport.DisplayAlerts = False
Set Sheet1 = ExcelReport.Sheets("Sheet1")
Set Sheet2 = ExcelReport.Sheets("Sheet2")
Set Sheet3 = ExcelReport.Sheets("Sheet3")
Set Sheet4 = ExcelReport.Sheets("Sheet4")

Sheet1.Activate
'theday = DateAdd("d", 1, DTPicker1.Value)
Set dbs = OpenDatabase(App.Path + "\APP\TL.mdb")
'dbs.Execute "delete from day1 "
SQLString = "select * from TL1 where DT='" & CStr(DTPicker1.Value) & "'"

dbs.Execute SQLString
Set rst = dbs.OpenRecordset("TL1")
If rst.EOF = False Then
rst.MoveFirst
End If

ExcelReport.Visible = True
i = 0
While rst.EOF = False
i = i + 1

Sheet1.Cells(i + 7, 2) = rst!GLFH
Sheet1.Cells(i + 7, 3) = rst!PH
Sheet1.Cells(i + 7, 4) = rst!TFTW
Sheet1.Cells(i + 7, 5) = rst!TFMD
Sheet1.Cells(i + 7, 6) = rst!JT1
Sheet1.Cells(i + 7, 7) = rst!CT1
Sheet1.Cells(i + 7, 8) = rst!JP1
Sheet1.Cells(i + 7, 9) = rst!CP1
Sheet1.Cells(i + 7, 10) = rst!CWSP
Sheet1.Cells(i + 7, 11) = rst!CWXP
Sheet1.Cells(i + 7, 12) = rst!XAI
Sheet1.Cells(i + 7, 13) = rst!XBI
Sheet1.Cells(i + 7, 14) = rst!XCI
Sheet1.Cells(i + 7, 15) = rst!MAI
Sheet1.Cells(i + 7, 16) = rst!MBI
Sheet1.Cells(i + 7, 17) = rst!YAI
Sheet1.Cells(i + 7, 18) = rst!YAP
Sheet1.Cells(i + 7, 19) = rst!YBI
Sheet1.Cells(i + 7, 20) = rst!YBP
Sheet1.Cells(i + 7, 21) = rst!SHAP
Sheet1.Cells(i + 7, 22) = rst!SHBP
Sheet1.Cells(i + 7, 23) = rst!SH_4MIDU
Sheet1.Cells(i + 7, 24) = rst!SGAI
Sheet1.Cells(i + 7, 25) = rst!SGBI
Sheet1.Cells(i + 7, 26) = rst!MFT
Sheet1.Cells(i + 7, 27) = rst!MFP

rst.MoveNext

Wend

ExcelReport.Visible = True
GoTo cc
aa:
ExcelReport.DisplayAlerts = False
Unload Me
cc:

End Sub

执行到 Set dbs = OpenDatabase(App.Path + "\APP\TL.mdb")之后就跳到了ExcelReport.DisplayAlerts = False

请高手们帮我看看我的程序哪里出问题了！！解决了再奉上积分。谢谢了！！在线等

Set dbs = OpenDatabase(App.Path + "\APP\TL.mdb")

参数不对：workspace.OpenDatabase（数据库名,打开模式,是否只读,连接字符串)
Set dbs=Workspaces(0).OpenDatabase(App.Path+"\APP\TL.mdb",False,False,"MS Access;PWD=***")

'下面引用ADO2.1
Private Sub Command1_Click()

On Error GoTo aa:
Dim dbs As New Connection '定义为数据库类型
Dim rst As Recordset '定义为记录类型
Dim theday As Date '定义为日期类型
Dim connstr As String
Dim i As Integer
Dim Bcell, Ecell, SQLString As String

Set ExcelReport = New Excel.Application
ExcelReport.Workbooks.Open FileName:=App.Path + "\APP\脱硫系统运行日志.xls"
ExcelReport.DisplayAlerts = False
Set Sheet1 = ExcelReport.Sheets("Sheet1")
Set Sheet2 = ExcelReport.Sheets("Sheet2")
Set Sheet3 = ExcelReport.Sheets("Sheet3")
Set Sheet4 = ExcelReport.Sheets("Sheet4")
Sheet1.Activate

theday = Day(CDate(DTPicker1.Value))

connstr = "DBQ=" + App.Path + "\APP\TL.mdb" + ";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
Set dbs = New Connection
dbs.Open connstr

'dbs.Execute "delete from day1 "
SQLString = "select * from TL1 where DT='" & CStr(DTPicker1.Value) & "'"

dbs.Execute SQLString

Set rst = dbs.Execute("select * from TL1")
If rst.EOF = False Then
rst.MoveFirst
End If

ExcelReport.Visible = True
i = 0
While rst.EOF = False
i = i + 1

Sheet1.Cells(i + 7, 2) = rst!GLFH
Sheet1.Cells(i + 7, 3) = rst!PH
Sheet1.Cells(i + 7, 4) = rst!TFTW
Sheet1.Cells(i + 7, 5) = rst!TFMD
Sheet1.Cells(i + 7, 6) = rst!JT1
Sheet1.Cells(i + 7, 7) = rst!CT1
Sheet1.Cells(i + 7, 8) = rst!JP1
Sheet1.Cells(i + 7, 9) = rst!CP1
Sheet1.Cells(i + 7, 10) = rst!CWSP
Sheet1.Cells(i + 7, 11) = rst!CWXP
Sheet1.Cells(i + 7, 12) = rst!XAI
Sheet1.Cells(i + 7, 13) = rst!XBI
Sheet1.Cells(i + 7, 14) = rst!XCI
Sheet1.Cells(i + 7, 15) = rst!MAI
Sheet1.Cells(i + 7, 16) = rst!MBI
Sheet1.Cells(i + 7, 17) = rst!YAI
Sheet1.Cells(i + 7, 18) = rst!YAP
Sheet1.Cells(i + 7, 19) = rst!YBI
Sheet1.Cells(i + 7, 20) = rst!YBP
Sheet1.Cells(i + 7, 21) = rst!SHAP
Sheet1.Cells(i + 7, 22) = rst!SHBP
Sheet1.Cells(i + 7, 23) = rst!SH_4MIDU
Sheet1.Cells(i + 7, 24) = rst!SGAI
Sheet1.Cells(i + 7, 25) = rst!SGBI
Sheet1.Cells(i + 7, 26) = rst!MFT
Sheet1.Cells(i + 7, 27) = rst!MFP

rst.MoveNext

Wend

ExcelReport.Visible = True
GoTo cc
aa:
ExcelReport.DisplayAlerts = False
dbs.Close
Set dbs = Nothing
Unload Me
cc:

End Sub

' '运行本程序需要引用microsoft dao 3.6 compatibility library '引用方法为：点击vb工程菜单，选择引用，选择microsoft dao 3.6 compatibility library并确定 '------------------------------------------------ private sub form_load() '窗口load过程 dim mydb as database dim mytb as recordset set mydb = opendatabase("c:\data.mdb") '打开数据库文件 set mytb = mydb.openrecordset("xpress") '打开表文件 if mytb.recordcount < 4 then '表文件记录小于4条退出程序 set mytb = nothing set mydb = nothing exit sub end if mytb.movefirst '记录指针移动到第一条 mytb.move 2 '记录指针向下移动2条即移动到第三条 text1.text = mytb!defaultvalue 'text1赋值为xpress表的defaultvalue字段的第三条记录 mytb.movenext '记录指针下移一条 text2.text = mytb!defaultvalue 'text2赋值为xpress表的defaultvalue字段的第四条记录 set mytb = nothing set mydb = nothing end sub private sub command1_click() dim mydb as database dim mytb as recordset set mydb = opendatabase("c:\data.mdb") set mytb = mydb.openrecordset("xpress") mytb.movefirst '记录指针移动到第一条 mytb.move 2 '记录指针下移到第三条 mytb.edit '数据库为编辑状态 mytb!defaultvalue = text1.text '数据库xpress表的defaultvalue字段第三条赋值为text1的文本 mytb.update '保存更改的记录 mytb.movenext '记录指针下移一条到第四条 mytb.edit mytb!defaultvalue = text2.text mytb.update set mytb = nothing set mydb = nothing end sub