Private Sub ListDept_Click() Dim sql As String sql = " select distinct 编号,姓名 from 员工 where 部门=' " & ListDept.Value & " ' order by 编号 asc " rst.Open sql, cnn, adOpenKeyset, adLockOptimistic Dim i As Integer With ListEmp .Clear For i = 1 To rst.RecordCount .AddItem rst( " 编号 " ) & Space ( 2 ) & rst( " 姓名 " ) rst.MoveNext End With rst.Close End Sub ' 将员工信息填入 textbox Private Sub ListEmp_Click() Dim i As Integer , IDStringCut As String Dim arr, brr Dim sql As String IDStringCut = Mid (ListEmp.Value, 1 , InStr (ListEmp.Value, Space ( 2 )) - 1 ) sql = " select * from 员工 where 编号=' " & IDStringCut & " ' " rst.Open sql, cnn, adOpenKeyset, adLockOptimistic ' 将每个字段的值存入空间 arr = Array( " txtID " , " txtName " , " txtAge " , " txtIDcard " , " txtDate " , " txtAddress " , _ " txtDept " , " txtJob " , " txtEMail " , " txtCV " ) brr = Array( " 编号 " , " 姓名 " , " 年龄 " , " 身份证号 " , " 聘用时间 " , " 工作地 " , _ " 部门 " , " 职务 " , " 电子邮件 " , " 简历 " ) For i = 0 To UBound (arr) Me .Controls(arr(i)).Value = rst(brr(i)) rst.Close End Sub ' 当窗体加载时，填写listDept Private Sub UserForm_Initialize() ' 建立数据库连接 Set cnn = New ADODB.Connection cnn_open cnn ' 提取不重复部门名称 Dim sql As String sql = " select distinct 部门 from 员工 " ' 执行sql语句 Set rst = New ADODB.Recordset rst.Open sql, cnn, adOpenKeyset, adLockOptimistic ' 将记录集中的部门显示到 listDept 列表框中 Dim i As Integer With ListDept .Clear ' 先清空再添加 For i = 1 To rst.RecordCount .AddItem rst( " 部门 " ) rst.MoveNext ' 将记录集中的指针指向下一条记录 End With rst.Close End Sub Sub cnn_open(cnn) With cnn .Provider = " microsoft.ace.oledb.12.0 " .ConnectionString = " data source= " & ThisWorkbook.Path & " \学生管理.accdb " .Open End With End Sub