为了便于管理手中的一大堆联系厂家的联系方式，我建立了一个ACCESS的数据库文件（TEST.MDB（表名：telephone）），把所有的客户信息存在数据库里面。但是由于操作ACCESS数据库很不方便，我平时又习惯使用EXCEL，所以便想做一个EXCEL文件，能够与这个数据库文件连接起来，实现对数据的搜索、添加功能。于是使用VBA。 当然首先是建立一个空白的EXCEL，并在里面针对数据库的各个字段标题建立标题。如： 姓名 公司 座机 手机 传真 打开VBA编辑器，添加三个模块： 模块1：（从数据库取得全部数据，并显示到EXCEL文件中） Public Sub Getmdb()  Dim cmd As String  Dim oAss As Object    connstr = "DBQ=D:\test.mdb;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"  Set oAss = CreateObject("ADODB.connection")  oAss.Open connstr  cmd = "SELECT * FROM telephone ORDER BY id DESC"  Set rs = oAss.Execute(cmd)   btop = 4  bleft = 2  ast = "A" & btop & ":Z1000"  Range(ast).ClearContents  Do While Not rs.EOF  btop = btop + 1  Cells(btop, bleft + 2) = rs("姓名")  Cells(btop, bleft + 3) = rs("公司")  Cells(btop, bleft + 4) = rs("座机")  Cells(btop, bleft + 5) = rs("手机")  Cells(btop, bleft + 6) = rs("传真")  rs.movenext  Loop  rs.CloseWorksheets(1).addcomEnd Sub 模块2：（从数据库中搜索符合指定名字或者公司名字的项目） Public Sub Serchmdb(ByVal so, si, st As String)  Dim cmd As String  Dim oAss As Object    connstr = "DBQ=D:\test.mdb;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"  Set oAss = CreateObject("ADODB.connection")  oAss.Open connstr  cmd = "SELECT * FROM telephone WHERE " + si + " like " + st + "%" + so + "%" + st  On Error GoTo 0  Set rs = oAss.Execute(cmd)   btop = 4  bleft = 2  btop = btop + 1  ast = "A" & btop & ":Z1000"  Range(ast).ClearContents    Do While Not rs.EOF  Cells(btop, bleft + 2) = rs("姓名")  Cells(btop, bleft + 3) = rs("公司")  Cells(btop, bleft + 4) = rs("座机")  Cells(btop, bleft + 5) = rs("手机")  Cells(btop, bleft + 6) = rs("传真")  btop = btop + 1  rs.movenext  Loop  rs.Close End Sub 模块3：（网数据库中添加数据的函数） Public Sub Addmdb(ByVal atype, aname, acomp, ajob, aphone, amobil, afax, aemail As String)  Dim cmd As String  Dim oAss As Object    connstr = "DBQ=D:\test.mdb;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"  Set oAss = CreateObject("ADODB.connection")  oAss.Open connstr  cmd = "INSERT INTO telephone ( 姓名,公司,职位,座机,手机,传真)"  cmd = cmd + " VALUES ('" +  aname + "','" + acomp + "','" + ajob + "','" + aphone + "','" + amobil + "','" + afax + "'')"   On Error GoTo 0  oAss.Execute (cmd) End Sub 在sheet1中添加以下内容： Dim so, si, st As String Private Sub ComboBox1_Change()（在EXCEL页面中添加ComboBox1控件，用于指定搜索项目名称）aa = ComboBox1.ListIndexIf aa < 0 Then  si = ""Else  si = ComboBox1.List(aa)End IfIf si <> "id" Then  st = "'"Else  st = ""End If End Sub Private Sub CommandAdd_Click()（在EXCEL页面中添加一个“添加项目”按钮，以及一系列的输入框，用于往数据库中添加内容）Dim aname, acomp, ajob, aphone, amobil, afax As String  aname = TextName.Text  acomp = TextComp.Text  ajob = TextJob.Text  aphone = TextPhone.Text  amobil = TextMobil.Text  afax = TextFax.Text  Addmdb atype, aname, acomp, ajob, aphone, amobil, afax, aemail  Serchmdb acomp, "公司", "'"End If End Sub Private Sub CommandButton1_Click()（在EXCEL中添加搜索输入框和“搜索”按钮，点击后开始搜索数据库）so = TextBox1.TextIf si = "" Then  si = ComboBox1.List(0)End IfIf si <> "id" Then  st = "'"Else  st = ""End IfSerchmdb so, si, stEnd Sub Public Sub addcom()（ComboBox1控件里面原来是空白的，需要在页面打开的时候往里面放入搜索的项目名称） With ComboBox1  .Clear  .AddItem "姓名"  .AddItem "公司"  .AddItem "座机"  .AddItem "手机"  .AddItem "传真"  .Text = .List(0)  si = .List(0)End WithEnd Sub 在ThisWorkBook中，添加： Private Sub Workbook_Open()（在页面打开时执行以下函数，也就是往ComboBox1中添加内容）Sheet1.addcomEnd Sub 至此，执行就完成所要的功能了，还差一点就是删除数据的功能，暂时很少用，就懒得编了。

评论