VB中运用DAO连接数据库
一、Visual Basic通过DAO和Jet引擎可以识别三类数据库:
■ VisualBasic数据库 也就是*.MDB数据库
■ 外部数据库它们是使用几种流行格式的“索引顺序访问方法(ISAM)”数据库，这些流行格式包括Btrieve、dBASEIII、dBASEIV、Microsoft FoxPro versions2.0和2.5以及Paradox versions 3.x和4.0。在Visual Basic中能够创建和操作所有以上格式的数据库。也可以访问文本文件数据库和Microsoft Excel或Lotus1-2-3电子表格。
■ ODBC数据库 包括符合ODBC标准的客户/服务器数据库，如Microsoft SQL Server。
二、连接方法举例
1、ACCESS数据库
'VBA中测试通过
'需引用DAO 3.6，3.6以下版本不支持ACCESS2000数据库
option explicit
Sub DAO_ACCESS() '连接带密码的ACCESS数据库
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(ThisWorkbook.Path & "\test.mdb", false, false, ";pwd=123")
Set rs = db.OpenRecordset("select * from 学生 where id =2")
MsgBox rs("学号") & " " & rs("姓名") & " " & rs("年龄")
rs.Closedb.Close
End Sub
2、FoxPro数据库
'VBA中测试通过
'需引用DAO 3.5（Jet 3.5），DAO 3.6(Jet 4.0)不支持FoxPro数据库。
'若非得引用DAO 3.6，也可把jet 3.5里的foxpro ISAM 注册信息导到4.0里，不过这样有可能发布的时候其它机器不兼容。
option explicit
' strConnect = "Dbase III;"
' strConnect = "Dbase IV;"
' strConnect = "Dbase 5.0;"
' strConnect = "FoxPro 2.0;"
' strConnect = "FoxPro 2.5;"
' strConnect = "FoxPro 2.6;"
' strConnect = "FoxPro 3.0;"
Sub DAO_DBF()
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(ThisWorkbook.Path, True, True, "FoxPro 3.0;")
Set rs = db.OpenRecordset("test.dbf", dbOpenSnapshot)MsgBox rs("学号") & " " & rs("姓名") & " " & rs("年龄")
rs.Close
db.Close
End Sub
补充一点，出现“Active不能创建对象”出错问题的解决方法是：
Windows Registry Editor Version 5.00[HKEY_CLASSES_ROOT\Licenses\F4FC596D-DFFE-11CF-9551-00AA00A3DC45]@="mbmabptebkjcdlgtjmskjwtsdhjbmkmwtrak"
3、EXCEL数据库
'VBA中测试通过
'需引用DAO 3.5或DAO 3.6'EXCEL2000对应EXCEL 8.0；EXCEL2003对应EXCEL 9.0
Sub DAO_xls()
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(ThisWorkbook.Path &"\test.xls", True, False, "EXCEL 8.0;")
Set rs = db.OpenRecordset("sheet1$")
MsgBox rs("学号") & " " & rs("姓名") & " " & rs("年龄")
rs.Close
db.Close
End Sub
4、SQL数据库
'VBA中测试通过
'需引用DAO 3.5或DAO 3.6
'需创建数源"dsn_test"
Sub dao_sql1()
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Dim name As String
strSQL = "ODBC;UID=sa;PWD=;DSN=dsn_test"
Set db = OpenDatabase("", False, False, strSQL)
Set rs = db.OpenRecordset("select * from students")
MsgBox rs("student_id") & " " & rs("student_name")
rs.Close
db.Close
End Sub
'不用创建数源
Sub dao_sql2()
Dim db As Database
Dim rs As Recordset
Dim strSQL As String
Dim name As String
strSQL = "ODBC;DRIVER={SQL Server};UID=sa;DATABASE=数据库名;SERVER=IP地址;PWD="
Set db = OpenDatabase("", False, False, strSQL)
Set rs = db.OpenRecordset("select * from students")
MsgBox rs("student_id") & " " & rs("student_name")
rs.Close
db.Close
End Sub
5、TXT文档
'VBA中测试通过
'需引用DAO 3.5或DAO 3.6
Sub DAO_TXT()
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(ThisWorkbook.Path, True, True, "text;")
Set rs = db.OpenRecordset("test.txt", dbOpenSnapshot)
MsgBox rs("学号") & " " & rs("姓名") & " " & rs("年龄")
rs.Close
db.Close
End Sub附：test.txt文件内容：
"学号","姓名","年龄"
"001","王小龙","13"
"002","李玉龙","17"
"003","张盼","15"三、应用实例1、创建数据库：
'VBA中测试通过
'创建数据库test.mdb，添加数据表“成绩表”，添加1条记录
Sub create_mdb()
Dim db As DAO.Database '定义数据库变量
Dim tbl As DAO.TableDef '定义数据表变量
Dim rs As DAO.Recordset '定义记录记变量
Dim myDBName As String
myDBName = ThisWorkbook.Path & "\test.mdb"
On Error Resume Next
Kill myDBName '删除已经存在的数据库文件
On Error GoTo 0
Set db = CreateDatabase(myDBName, dbLangChineseSimplified) '创建数据库文件
Set tbl = db.CreateTableDef("成绩表") '创建数据表
'为数据表添加字段
With tbl
.Fields.Append .CreateField("学号", dbText, 8)
.Fields.Append .CreateField("姓名", dbText, 6)
.Fields.Append .CreateField("性别", dbText, 1)
.Fields.Append .CreateField("学科", dbText, 20)
.Fields.Append .CreateField("成绩", dbSingle)
End With
db.TableDefs.Append tbl '将数据表添加到数据库对象中
Set rs = db.OpenRecordset("select * from 成绩表") '打开记录记
'添加记录
rs.AddNew
rs.Fields("学号") = "001"
rs.Fields("姓名") = "李海"
rs.Fields("性别") = "男"
rs.Fields("学科") = "语文"
rs.Fields("成绩") = 135
rs.Update
rs.Close '关闭记录记
Set rs = Nothing '释放变量
db.Close '关闭数据库
Set db = Nothing '释放变量
End Sub
2、打开数据库：
'VBA中测试通过
'打开ACCESS数据库TEST.MDB
Sub OpenDB_MDB()
Dim dbase as Database
Dim rs As Recordset
Set dbase = OpenDatabase (App.path & "\TEST.MDB" )
Set rs = dbase.OpenRecordset (" select * from 表名 " )
End Sub
3、使用数据库：
当打开数据库，建立Recordset 记录集后，便可浏览、删除、添加、查找数据库中的内容。
1）向前浏览
'VBA中测试通过
Sub previous_mdb()
Dim dbase as Database
Dim rs As Recordset
Set dbase = OpenDatabase (App.path & "\TEST.MDB" )
Set rs = dbase.OpenRecordset (" select * from 表名 " )
rs.MovePrevious
if rs.BOF =True then
rs.Movelast
End if
for i = 0 to 11
label(i).caption = rs.Fields(i) & ""
next
End Sub
在字段赋值的末尾加上""可以避免许多不必要的错误，在数据库中，当一个字段为空的时候，它的值为Null ，Null表示什么也没有。因此无法赋值，赋给变量时会出错。但我们加上""空格符时，便有效的避免了赋值错误，这个技巧非常的有用。 2）向后浏览
'VBA中测试通过
Sub next_mdb()
Dim dbase as Database Dim rs As Recordset Set dbase = OpenDatabase (App.path & "\TEST.MDB" ) Set rs = dbase.OpenRecordset (" select * from 表名 " ) rs.MoveNext If rs.EOF =True then rs.MoveFirst End if for i = 0 to 11 label(i).caption = rs.Fields(i) & "" next End Sub 3）删除记录 Sub del_mdb() On Error GoTo handle
Dim dbase as Database Dim rs As Recordset
Dim msg as string Set dbase = OpenDatabase (App.path & "\TEST.MDB" ) Set rs = dbase.OpenRecordset (" select * from 表名 " ) msg = "是否要删除记录"& Chr$(10) msg = msg & label(0) ′把删除记录的代号加入msg中 If Msgbox(msg , 17 , "删除记录") <> 1 Then Exit sub rs.delete rs.Movenext If rs.EOF = True Then rs.MovePrevious End if for i = 0 to 11 label(i).caption = rs.Fields(i) & "" next handle: MsgBox "该记录无法删除!!!" Exit Sub End Sub 4）添加记录 向数据库中添加记录比较麻烦一点，大致分为三步：首先，用AddNew方法向数据库添加一个新的空白记录；其次，将要输入的数据分别赋到数据库的各个字段中；最后，用Updata的方法，把记录写到数据库中去。例如： Sub new_mdb()
Dim dbase as Database Dim rs As Recordset
Dim msg as string Set dbase = OpenDatabase (App.path & "\TEST.MDB" ) Set rs = dbase.OpenRecordset (" select * from 表名 " )
rs.AddNew For i = 0 to 11 rs.Fields(i) = TextBox(i).Text Next rs.Updata End Sub 5）查找记录 查找记录可以用Find方法，例如： Sub search_mdb()
Dim dbase as Database Dim rs As Recordset
Dim msg as string Set dbase = OpenDatabase (App.path & "\TEST.MDB" ) Set rs = dbase.openRecordset("表名"，dbopenDynaset) rs.findfirst "字段名= ' " & Text.Text & " ' " ′ Text.Text是输入的关键字 if rs.Nomatch = True then Msgbox "对不起，没有该记录" else For i = 0 to 11 label(i).caption = rs.Fields(i) & "" Next
加载中…