为了便于管理手中的一大堆联系厂家的联系方式，我建立了一个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.Close
Worksheets(1).addcom
End 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.ListIndex
If aa < 0 Then
si = ""
Else
si = ComboBox1.List(aa)
End If
If 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.Text
If si = "" Then
si = ComboBox1.List(0)
End If
If si <> "id" Then
st = "'"
Else
st = ""
End If
Serchmdb so, si, st
End Sub
Public Sub addcom()（ComboBox1控件里面原来是空白的，需要在页面打开的时候往里面放入搜索的项目名称）
With ComboBox1
.Clear
.AddItem "姓名"
.AddItem "公司"
.AddItem "座机"
.AddItem "手机"
.AddItem "传真"
.Text = .List(0)
si = .List(0)
End With
End Sub
在ThisWorkBook中，添加：
Private Sub Workbook_Open()（在页面打开时执行以下函数，也就是往ComboBox1中添加内容）
Sheet1.addcom
End Sub
至此，执行就完成所要的功能了，还差一点就是删除数据的功能，暂时很少用，就懒得编了。
评论