Excel VBA编程  典型实例——读取ACCESS数据
利用VBA，不仅可以对文本文件进行操作，还可以对Office其他组件进行操作。例如，通过ADO读取ACCESS中的数据，这样使得Excel更加灵活。

1．练习要点
●使用ADO连接
●查询数据库数据
2．操作步骤
（1）启动Excel 2007，并打开VBE窗口，新建一个用户窗体，设置其Caption为“人员信息查询”。
（2）在该窗体中，添加一个多页控件，设置其中一个页为“查”，并在该页中添加如图18-8所示的控件。
图18-8  添加控件
（3）设置另一个页为“资料”，并添加如图18-9所示的控件。
图18-9  设置“资料”页
（4）在页控件下面添加一个命令按钮，并设置其Caption属性为“关闭”，如图18-10所示。
图18-10  添加按钮
（5）打开该窗体的【代码】窗口，在窗体的Initialize事件代码。
'声明ADO连接对象
Dim cnn As ADODB.Connection
'声明ADO命令对象
Dim cmd As ADODB.Command
Private Sub UserForm_Initialize()
    Dim strCon As String
    '为复合框添加数据
    cbxFind.AddItem "身份证号码"
    cbxFind.AddItem "姓名"
    cbxFind.AddItem "出生日期"
    cbxFind.AddItem "单位名称"
    cbxFind.ListIndex = 0
    '设置列表框为3列
    lstInfo.ColumnCount = 3
    '设置列表框各列的宽度
    lstInfo.ColumnWidths = "20;100;60"
    '新建连接对象
    Set cnn = New ADODB.Connection
    '定义连接字符串
    strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
        ThisWorkbook.Path & "\数据库.mdb"
    '设置连接参数
    cnn.ConnectionString = strCon
    '新建命令对象
    Set cmd = New ADODB.Command
    '打开“查”页
    Me.MultiPage1.SelectedItem.Index = 0
End Sub
（6）设置“查”按钮的Click事件。
Private Sub cmdFind_Click()
    '声明保存SQL语句
    Dim strSql As String
    Dim rs As ADODB.Recordset
    '说明数组
    Dim aRs(100, 3) As String
    Dim i As Integervba数据库编程
   
    If txtKey.Value = "" Then
        MsgBox "请输入查询关键字"
        txtKey.SetFocus
        Exit Sub
    End If
   
    '根据不同字段生成查询
    Select Case cbxFind.Value
    Case "身份证号码"
        strSql = "Select * From 人员信息 Where Identifcard_id Like '%" & txtKey.Value & "%'"
    Case "姓名"
        strSql = "Select * From 人员信息 Where Member_Name Like '%" & txtKey.Value & "%'"
    Case "出生日期"
        '判断日期格式是否正确
        If IsDate(txtKey.Value) Then
            strSql = "Select * From 人员信息 Where Birthday=#" & txtKey.Value & "#"
        Else
            MsgBox "请输入正确的日期格式！"
            txtKey.SetFocus
            Exit Sub
        End If
    Case "单位名称"
        strSql = "Select a.Identifcard_id,a.Member_Name,b.unit_name " & _
            " From 人员信息 AS a, 工作单位 AS b " & _
            " Where a.unit_id=b.unit_id AND b.unit_name Like '%" & txtKey.Value & "%'"
    End Select
    '打开ADO连接
    cnn.Open
    '设置命令对象的连接属性
    cmd.ActiveConnection = cnn
    '设置命令对象执行的SQL语句
    cmd.CommandText = strSql
    '执行SQL语句,将结果保存在记录集中
    Set rs = cmd.Execute()
   
    i = 0
    '循环处理记录集
    Do While Not rs.EOF
        aRs(i, 0) = rs.Fields("ID").Value
        aRs(i, 1) = rs.Fields("Identifcard_id").Value
        aRs(i, 2) = rs.Fields("Member_Name").Value
        i = i + 1
        rs.MoveNext
    Loop
    '清除列表框中的数据
    lstInfo.Clear
    '列表框赋值
    lstInfo.List() = aRs